Hallo liebe Excelperten,
ich bin bereits weit in meinem Excelprojekt vorangeschritten, ein ansprechendes Layout für Angebote zu erstellen. Als letzten Schritt arbeite ich daran noch ein paar Bilder hinzuzufügen, die sich natürlich auf das angebotene Produkt beziehen sollen. Die Bilder liegen alle auf dem Server weshalb ich mit einem Pfad arbeite.
Das klappt alles soweit ganz gut, aber wenn ich die Bilder horizontal und vertical zentrieren will, funktioniert es leider nicht. Mir rutscht das Bild dann immer über die Ränder des Bereichs B8:B24. Mir scheint, dass das Makro das Bild nicht erkennt, da in "pic.height" und in "pic.width" immer 0 steht. Haber versucht dies über Namen zu lösen, klappt aber leider nicht. Hättet Ihr hier vielleicht eine Idee? Anbei der Code.
Option Explicit
Sub Insert_Pictures()
Dim Pfad As String
Dim picname As String
Dim pic As Shape
Pfad = "C:\Users\ps60104\Pictures\John Deere\"
picname = Range("B4")
Range("B8").Activate
ActiveSheet.Pictures.Insert(Pfad & Range("B8") & picname & ".png").Select
With Selection
'.ShapeRange.LockAspectRatio = msoFalse
.Name = "Picture 1"
.Height = Range("B8:h24").Height
If .Width > Range("B8:h24").Width Then
.Width = Range("B8:h24").Width
End If
pic = Shapes("Picture 1")
'Hier kommt eine Fehlermeldung
.Top = (Range("B8:h24").Height - pic.Height) / 2
'Hier rutscht das Bild über die Zellränder hinaus
.Left = (Range("B8:h24").Width - pic.Width) / 2
'Hier rutscht das Bild über die Zellränder hinaus
.Placement = xlMoveAndSize
End With
Exit Sub
ErrNoPhoto:
MsgBox "Unable to Find Photo" 'Shows message box if picture not found
Exit Sub
Range("B4").Select
End Sub
Ich hätte noch eine 2. Frage. Die Zelle B4 ist ein Gültigkeitsfeld , was die Produkte beinhaltet. Es ware ganz toll, das wenn jedesmal der Wert im Gültigkeitsfeld geändert wird, die alten Bilder gelöscht werden und die neuen Bilder eingefügt werden. Geht das?
Vielen lieben Dank für Eure Tipps & Tricks.
Mit freundlichen Grüßen
Peter
