vba voor het invoegen van een foto

[joh88]

Goedenavond,

sinds enkele weken ben ik bezig met een Excel bestand en om het gebruiksvriendelijker te maken wil ik een aantal VBA toevoegen.
ik wil een foto invoegen vanuit een map met meer als 1000 items.
De foto's hebben allemaal een nummer dat nummer correspondeert met gegevens uit een cel.

als ik de code opneem dan krijg ik deze code:

[CODE][INDENT]Sub fotoinvoegen()[/INDENT]
[INDENT]'[/INDENT]
[INDENT]' fotoinvoegen Macro[/INDENT]
[INDENT]'[/INDENT]
[INDENT]
[/INDENT]
[INDENT]'[/INDENT]
[INDENT]    Range("J19:K20").Select[/INDENT]
[INDENT]    Selection.Copy[/INDENT]
[INDENT]    ActiveSheet.Pictures.Insert("G:\DORLC BAD Goederen\Afbeelding\[COLOR=#ff0000]8529335[/COLOR].jpeg"). _[COLOR=#ff0000] (dit is de waarde van de cel)[/COLOR][/INDENT]
[INDENT]        Select[/INDENT]
[INDENT]End Sub[/INDENT]

[/CODE]
dit werkt goed maar als er een andere waarde in cel J19:K20 komt neemt hij niet die gegevens over.
als iemand mij hierin zou kunnen helpen ben ik ontzettend blij!

groetjes

 

[HSV]

Hier heb je in principe genoeg aan met de naam van de foto in cel A1.

Sub fotoinvoegen()
 ActiveSheet.Pictures.Insert "G:\DORLC BAD Goederen\Afbeelding\" & range("a1").value & ".jpeg"
end sub

 

[joh88]

Goedemiddag,

helaas werkt deze niet,
ik krijg een foutmelding voor het pad van de loc van de afbeelding.

 

[HSV]

Wat staat er in cel A1?

 

[joh88]

deze cel is leeg, de gegevens die hij moet uitlezen staan in J19:k20.
als ik de A1 vervang voor die cellen dan neemt hij hem nog niet

 

[HSV]

Zet de naam van de foto in cel A1 en draai de code.

Zoals in jouw voorbeeld: 8529335

 

[joh88]

super hij werkt!

mijn dank is groot!

 

[HSV]

Mooi, ...vraagje.

Ga je nu een x aantal foto's invoegen?
Die stapelen zich allemaal op elkaar namelijk.

 

[joh88]

de foto komt op 3 verschillende plekken in het tabblad, en als het nummer wijzigt moet eigenlijk ook de foto weer weg maar dat is ook eventueel handmatig weg te halen

 

[joh88]

ik heb nog wel 1 vraag, de foto komt nu in de cel die geselecteerd is. als ik ze in een andere cel terecht wil laten komen hoe kan ik dat het beste wegschrijven in de code?

 

[HSV]

Het mooiste is een Image invoegen, maar dat gaat met een geheel andere code.

Om bij jouw voorbeeld te blijven.
Zo wordt de eerder afbeelding verwijderd (bij een lege start zonder plaatjes) en plaatst de foto bij cel A10.

Sub fotoinvoegen()
On Error Resume Next
 With ActiveSheet
   .Shapes("afbeelding").Delete
   .Pictures.Insert("G:\DORLC BAD Goederen\Afbeelding\" & range("a1").value & ".jpeg").Name = "afbeelding"
      With .Pictures
          .Top = Range("a10").Top '
          .Left = Range("a10").Left
          .Width = (.Width / .Height) * Range("a10").Height * 10
          .Height = Range("a10").Height * 10
      End With
 End With
End Sub

 

[joh88]

Goedenavond Harry,

zo werkt hij inderdaad goed.
ik probeer datzelfde plaatje ook op een andere plek in het werkblad te plaatsen.
dus op a10 maar ook op C3 bijvoorbeeld, maar wat ik ook probeer dan gaan de foto's op een willekeurige plaats in het tabblad staan.

hieronder de code zoals ik hem had bedacht maar dan komen ze dus random om het tabblad en soms blijven er verkeerde foto's staan.

denk ik gewoon te makkelijk om de code te kopieren

Sub Invoegen()

On Error Resume Next
 With ActiveSheet
   .Shapes("afbeelding").Delete
   .Pictures.Insert("G:\DORLC BAD Goederen\Afbeelding\" & Range("J19").Value & ".jpeg").Name = "afbeelding"
      With .Pictures
          .Top = Range("G2").Top * 1
          .Left = Range("G2").Left
          .Width = (.Width / .Height) * Range("G2").Height * 7
          .Height = Range("G2").Height * 7
      End With
 On Error Resume Next
 With ActiveSheet
   .Pictures.Insert("G:\DORLC BAD Goederen\Afbeelding\" & Range("J19").Value & ".jpeg").Name = "afbeelding"
      With .Pictures
          .Top = Range("L19").Top * 1
          .Left = Range("L19").Left
          .Width = (.Width / .Height) * Range("L19").Height * 7
          .Height = Range("L19").Height * 7
      End With
 End With
 End With
 
End Sub

 

[HSV]

Andere benamingen geven en andere methode.

Sub Invoegen()
On Error Resume Next
 With ActiveSheet
   .Shapes("afbeelding1").Delete
   .Pictures.Insert("G:\DORLC BAD Goederen\Afbeelding\" & Range("J19").Value & ".jpeg").Name = "afbeelding1"
      With .Shapes("afbeelding1")
          .Top = Range("G2").Top
          .Left = Range("G2").Left
          .Width = (.Width / .Height) * Range("G2").Height * 7
          .Height = Range("G2").Height * 7
      End With
   .Shapes("afbeelding2").Delete
   .Pictures.Insert("[COLOR=#3E3E3E]G:\DORLC BAD Goederen\Afbeelding\[/COLOR]" & Range("J19").Value & ".jpeg").Name = "afbeelding2"
      With .Shapes("afbeelding2")
          .Top = Range("L19").Top 
          .Left = Range("L19").Left
          .Width = (.Width / .Height) * Range("L19").Height * 7
          .Height = Range("L19").Height * 7
      End With
 End With
 End Sub