Afbeelding invoegen in een cel en naam geven

[MvanderS]

Ik ben een scriptje aan het schrijven voor het invoegen van afbeeldingen in Excel. De bedoeling is dat er een afbeelding wordt ingevoegd en de afmetingen daarvan worden aangepast aan de grootte van de cel waarin die wordt ingevoegd. De afbeelding moet daarna ook een naam krijgen, en niet zoals nu gebeurd de naam "afbeelding en nummer".

Ik heb 2 scripts, de ene voegt de afbeelding in in een cel.
De ander voegt een afbeelding in en geeft een naam aan de afbeelding.

Ik krijg ze niet gecombineerd. De volgende scripts heb ik.
SCRIPT 1

Sub TestInsertPictureInRange()
Dim BestandsLoc As String
Dim AfbNaam As String

BestandsLoc = "C:\Documents and Settings\MvanderS\Mijn documenten\Mijn afbeeldingen\"

AfbNaam = ActiveCell.Value
    AfbNaam = Worksheets("Collage").Range("O16").Value
    Range("O16").Select
    InsertPictureInRange BestandsLoc & AfbNaam & ".jpg", _
        'Range("H16").Select

Sub InsertPictureInRange(PictureFileName As String, TargetCells As Range)
' inserts a picture and resizes it to fit the TargetCells range
Dim p As Object, t As Double, l As Double, w As Double, h As Double
    If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub
    If Dir(PictureFileName) = "" Then Exit Sub
    ' import picture
    Set p = ActiveSheet.Pictures.Insert(PictureFileName)
    
    ' determine positions
    With TargetCells
        t = .Top
        l = .Left
        w = .Offset(0, .Columns.Count).Left - .Left
        h = .Offset(.Rows.Count, 0).Top - .Top
    End With
    ' position picture
    With p
        .Top = t
        .Left = l
        .Width = w
        .Height = h
    End With
    Set p = Nothing
    
End Sub

SCRIPT 2

Sub Afbeeldinginvoegen
Dim BestandsLoc As String
Dim AfbNaam As String
    AfbNaam = Worksheets("Collage").Range("O16").Value
    BestandsLoc = "C:\Documents and Settings\MvanderS\Mijn documenten\Mijn afbeeldingen\"
    AfbBestandsNaam = BestandsLoc & AfbNaam & ".jpg"
    
    Worksheets("Collage").Pictures.Insert(AfbBestandsNaam).Name = AfbNaam
     
End Sub

Ik hoop dat iemand mij hiermee kan helpen.

 

[djalive]

Hi M.

Jij hebt schijnbaar precies het antwoord op een probleem van mij.
Ik voeg vaak afb in in excel maar moet iedere keer de afmeting instellen.

Helaas kan ik jou niet helpen, want ik heb geen flauw idee hoe dat allemaal werkt met die scripts (vind t wel indrukwekkend).
Zou jij mij willen en kunnen uitleggen hoe ik het script van jou kan toepassen dat de afbeeldingen automatisch aan de cel aanpast (afmetingen dus) en hoe ik dit precies moet gebruiken?

Ondanks dat ik jou niet kan helpen, zou ik je toch zéér dankbaar zijn.

Grtz. Rinie.

 

[MvanderS]

Ik heb inmiddels zelf het antwoordt gevonden, het was eigenlijk heel simpel. De toevoeging heb ik rood gemaakt.

Sub TestInsertPictureInRange()
Dim BestandsLoc As String
Dim AfbNaam As String

BestandsLoc = "C:\Documents and Settings\MvanderS\Mijn documenten\Mijn afbeeldingen\"

AfbNaam = ActiveCell.Value
AfbNaam = Worksheets("Collage").Range("O16").Value
Range("O16").Select
InsertPictureInRange BestandsLoc & AfbNaam & ".jpg", _
'Range("H16").Select

Sub InsertPictureInRange(PictureFileName As String, TargetCells As Range)
' inserts a picture and resizes it to fit the TargetCells range
Dim p As Object, t As Double, l As Double, w As Double, h As Double
If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub
If Dir(PictureFileName) = "" Then Exit Sub
' import picture
Set p = ActiveSheet.Pictures.Insert(PictureFileName)
AfbNaam = Worksheets("Collage").Range("O16").Value

' determine positions
With TargetCells
t = .Top
l = .Left
w = .Offset(0, .Columns.Count).Left - .Left
h = .Offset(.Rows.Count, 0).Top - .Top
End With
' position picture
With p
.Name = AfbNaam
.Top = t
.Left = l
.Width = w
.Height = h
End With
Set p = Nothing

End Sub

 

[MvanderS]

Vertel even wat meer over de toepassing van het invoegen van de afbeeldingen en waar deze afbeeldingen vandaan komen (bestandslocatie). Misschien dat ik het script een klein beetje kan aanpassen zodat het bruikbaar is voor jou.

 

[djalive]

Vertel even wat meer over de toepassing van het invoegen van de afbeeldingen en waar deze afbeeldingen vandaan komen (bestandslocatie). Misschien dat ik het script een klein beetje kan aanpassen zodat het bruikbaar is voor jou.

Om niet steeds nieuwe programma's te hoeven gebruiken voor mijn cd hoesjes (ben dj van beroep) heb ik jaren geleden een CD hoes Lay Out gemaakt in Excel.
Op de voorkant de titel van de compilatie cd, daaronder 16 separate vakken waar de hoes afbeeldingen in komen, en op de achterkant de TOC.
Die hoesafbeeldingen, daar gaat het om, maar die hebben geen vaste locatie.
Ik koop mn muziek bij I tunes, en doe de afbeelding vanuit itunes plakken in excel (dmv Polenta Screenshot, variant op Print screen toets).
Eerst met Polenta knippen en dan in de bewuste cel ctrl-v.
Maar ook in de mappen van muziek (heb voor iedere single een eigen map met daarin div remixen) staan soms afbeeldingen die ik dan weer ophaal in excel via invoegen/bestand en dan bladeren maar.
Ten slotte komen er soms ook afbeeldingen van het net.
Alleen alle afbeeldingen zijn meestal te groot, en moet ze dan op 2.3*2.3 aanpassen, handmatig.
Als dit automatisch kon, zou dat top zijn. Had t al geprobeerd via celeigenschappen, maar helaaas....

Hoop dat je er wijs uit komt.

Grtz Rinie.

 

[MvanderS]

Ik kan je alleen helpen met afbeeldingen die al reeds in je map met afbeeldingen staan helpen. Je zal de afbeeldingen dan wel een consequente naam moeten geven. Je laat namelijk zoeken op die naam om dan in de aangewezen cel in te voegen doormiddel van het drukken op een knopje waarachter het script zit.

Kan je het excel document en een bestandslocatie naar de map waar je je afbeeldingen voor je cd hoesjes neerzet miss naar mij sturen op de een of andere manier?

Sorry voor de late reactie!

 

[MvanderS]

Ik ben inmiddels bij het volgende probleem aangekomen. Ik laat bij het sluiten afbeeldingen verwijderen, die zijn ingevoegd. Dus niet met een functie voor het verwijderen van alle afbeeldingen. De afbeelding krijgt bij het invoegen een naam, en bij het sluiten wordt dezelfde naam gebruikt voor het verwijderen van de afbeelding.
Op het moment dat de afbeelding handmatig is verwijderd en dan het script wordt aangeroepen voor het verwijderen van die afbeelding gebeuren er gekke dingen. Er worden cellen verwijderd en ik heb het vermoeden dat dat gebeurd met de cellen waarop de cursor op dat moment staat.

Hoe kan ik iets erin bouwen dat op het moment dat de afbeelding niet gevonden wordt het deleten overgeslagen wordt en naar de volgende afbeelding gaat?

 

[djalive]

Ik kan je alleen helpen met afbeeldingen die al reeds in je map met afbeeldingen staan helpen. Je zal de afbeeldingen dan wel een consequente naam moeten geven. Je laat namelijk zoeken op die naam om dan in de aangewezen cel in te voegen doormiddel van het drukken op een knopje waarachter het script zit.

Kan je het excel document en een bestandslocatie naar de map waar je je afbeeldingen voor je cd hoesjes neerzet miss naar mij sturen op de een of andere manier?

Sorry voor de late reactie!

Ook ik sorry vor de late reactie, maar als ik de bestanden moet gaan hernoemen, en in vaste mappen plaatsen, dan is het makkelijker om ze in de cellen handmatig aan te passen.
gaat sneller als renamen etc.
Toch hartstikke bedankt voor je moeite en kennis....

 

[wheellywally]

vraag over welke naam de foto moet hebben

Goede avond na een week studeren op vba (voor deze week nog nooit van gehoord)
heb ik Visuel basic aan de gang en me eerste basis cursus er op zitten
aan gezien ik erg fanatiek ben en me eerste scriptje nu toe probeer te passen deze zoals hierboven staat geschreven.
gaat er iets niet goed bij me ik heb de map locatie in het script aangepast
nu is alleen de vraag hoe moet ik de fotos noemen om ze te kunnen vinden en hoe pas ik het scripje zo aan dat het voor alle cellen in het werkblad geld of specifiek voor een cel
ik hoop dat me vraag duidelijk is en dat iemand me opweg wil helpen ivm de hoge intresse voor de scriptje