Bilder automatisch in Excel einfügen, jedoch mit bestimmter Größe und Position

Question

Hallo Oliver,
das Makro auf der Seite https://supportnet.de/fresh/2005/11/id1193541.asp ist super. Ich stand vor dem gleichen Problem wie Andreas, welcher zu 80 % mit deinem Makro gelöst ist.
Um mein Problem vollständig zu lösen wäre es perfekt, wenn man das Bild, wie Du es bereits erwähnt hast, in einer bestimmten Größe und Position einfügen könnte.

z.B. die Bildnummer ist bei A1, dann soll das Bild in der Größe 10x10cm in der Zelle A5 eingefügt werden.

Ist das mit einer Befehlszeile in Deinem vorhanden Makro möglich? Ich möchte ungerne etwas was schon funktioniert zu zerstören.

Danke
Gruß Alem

Answer 1

Hallo Alem,

hier mal ein Beispiel, wie du ein Bild einfügen kannst, wenn der Bildname (hier ohne die Endung .jpg) in Zelle A1 steht:

Sub Bild_einfuegen()

Dim strDatnam As String

'Pfad anpassen, ggf. Ergänzung jpg entfernen
strDatnam = "C:\Users\DeinName\Pictures\" & Range("A1").Value & ".jpg"

'Bild in Zelle A5 einfügen, Größe 10 cm; 1 cm = 28,35 pt
ActiveSheet.Shapes.AddPicture strDatnam, msoFalse, msoTrue, Range("A5").Left, Range("A5").Top, 283.5, 283.5

End Sub

Wie du siehst, geschieht das Einfügen und skalieren in einer Zeile. Falls du Probleme hast, dein vorhandes Makro anzupassen, dann melde dich.
Den Pfad musst du natürlich auf deine Verhältnisse anpassen. Falls dein Bildname mit Endung in der Zelle A1 steht, dann kannst du den Codeteil & ".jpg" löschen.

Gruß

M.O.

Answer 2

Hallo Oliver,

Danke für Deine Antwort. So schnell hätte ich Sie nicht erwartet.
Ich bekomme die beiden Makros leider nicht zu einem.

Dieses Makro funktioniert.

Option Explicit

Sub Bilder_einfügen()
Dim Pfad As String, Wiederholungen As Long
On Error Resume Next
Pfad = "C:\Users\Alem\Pictures\Saved Pictures\"
For Wiederholungen = 2 To Range("A65536").End(xlUp).Row
Cells(Wiederholungen, 3).Activate
ActiveSheet.Pictures.Insert(Pfad & Cells(Wiederholungen, 1) & ".jpg").Select
Next
End Sub

und folgendes auch:

Sub Bilder_einfügen()
Dim strDatnam As String
On Error Resume Next
strDatnam = "C:\Users\Alem\Pictures\Saved Pictures\" & Range("A2").Value & ".jpg"
ActiveSheet.Shapes.AddPicture strDatnam, msoFalse, msoTrue, Range("d2").Left, Range("d2").Top, 283.5, 283.5
End Sub

Ich möchte gerne das beides zusammen funktioniert.

In der ersten Spalte A will ich untereinander Bildernamen z.B. Bild 1 (A1), Bild 2 (A2), Bild 3 (A3) usw.
und wenn das Makro ausgeführt wird, soll neben den jeweiligen Spalten B1, B2, B3 usw. das Bild erscheinen.

Meim ersten Makro nimmt er das jeweilige Bild, aber positioniert es immer an der gleichen stelle, so das dieses Bild von den folgenden überlagert wird. Ich muss die dann noch manuell positionieren, was ich gerne vermeiden möchte.

Geht das überhaupt? Konnte ich mich einigermaßen verständlich ausdrücken?

Schöne Grüße Alem

Answer 3

Hallo Alem,

hier das geänderte Makro, das alle Zellen in Spalte A ab A1 durchläuft und die Bilder in Spalte B in der Größe 10 cm x 10 cm einfügt:

Sub Bilder_einfügen()
Dim Pfad As String
Dim strDatnam As String
Dim Wiederholungen As Long
On Error Resume Next
'Pfad = "C:\Users\Alem\Pictures\Saved Pictures\"
Pfad = "C:\Users\obenauer\Pictures\"
For Wiederholungen = 1 To Range("A65536").End(xlUp).Row
strDatnam = Pfad & Cells(Wiederholungen, 1).Value & ".jpg"
ActiveSheet.Shapes.AddPicture strDatnam, msoFalse, msoTrue, Cells(Wiederholungen, 2).Left, Cells(Wiederholungen, 2).Top, 283.5, 283.5
Next
End Sub

Gruß

M.O.

P.S.: Ich bin nicht Oliver ;-).

Answer 4

Hallo M.O.,

Super. Danke. I am happy :-) !!!
Hast mir sehr weitergeholfen.

Schöne Grüße
Alem