Hallo,
ändere den Teil für das Löschen der Bilder wie folgt:
For Each shp In ActiveSheet.Shapes
If Left(shp.Name, 7) = "Picture" Then shp.Delete
Next
Zu deinem Bild in E1: Wenn du immer ein Bild bestimmtes Bild in E10 mit der Größe 10 cm x 10 cm einfügen willst, dann ist das kein Problem.
Da du aber geschrieben hast:
Ich würde nun gern noch ein Bild 10x10cm in Zelle E1 einfügen (Maße und Zelle variabel)
gehe ich mal davon aus, dass nicht immer die Zelle E1 genommen werden soll und nicht immer die Größe 10 cm x 10 cm genommen werden soll. Dann musst du die Angaben im Tabellenblatt machen.
Bsp:
- in die Zelle X1 schreibst du den Namen des Bildes (ohne Endung)
- in die Zelle X2 schreibst du die Zelle, in der das Bild eingefügt werden soll; z.B. E1
- in die Zelle X3 schreibst du die Höhe in cm; z.B. 10
- in die Zelle X4 schreibst du die Breite in cm, z.B. 10
Dann führe mal den folgenden ergänzten Code aus:
Private Sub CommandButton1_Click()
Dim Pfad As String
Dim strDatnam As String
Dim Wiederholungen As Long
Dim shp As Shape
Dim Hoehe As Single
Dim Breite As Single
'Pfad = "G:\Bilder\"
Pfad = "C:\Test\"
'Alle Bilder im Blatt löschen
For Each shp In ActiveSheet.Shapes
If Left(shp.Name, 7) = "Picture" Then shp.Delete
Next
'Spalte A ab Zeile 2 durchlaufen
For Wiederholungen = 2 To ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
'Namen der Bilder stehen in Spalte A - ohne Endung; Einlesen in Variable mit Pfadangaben
strDatnam = Pfad & Cells(Wiederholungen, 1).Value & ".jpg"
'Prüfen, ob Bilddatei im Verzeichnis existiert
If Dir(strDatnam) <> "" Then
'falls ja: Bilder werden in Spalte B eingefügt, Größe 3 x 3 cm
ActiveSheet.Shapes.AddPicture strDatnam, msoFalse, msoTrue, Cells(Wiederholungen, 2).Left, Cells(Wiederholungen, 2).Top, 85, 85
Else
'falls nein, wird in Spalte B eine Fehlermeldung geschrieben
ActiveSheet.Cells(Wiederholungen, 2) = "Bild nicht gefunden"
End If
Next
'Nun das Bild aus Spalte X einfügen
strDatnam = Pfad & ActiveSheet.Range("X1").Value & ".jpg" 'Name des Bildes
Hoehe = ActiveSheet.Range("X3").Value * 28.35 'Höhe des Bildes
Breite = ActiveSheet.Range("X4").Value * 28.35 'Breite des Bildes
'Prüfen, ob Bilddatei im Verzeichnis existiert
If Dir(strDatnam) <> "" Then
'falls ja: Bilder werden in Spalte B eingefügt, Größe 3 x 3 cm
ActiveSheet.Shapes.AddPicture strDatnam, msoFalse, msoTrue, ActiveSheet.Range(ActiveSheet.Range("X2")).Left, ActiveSheet.Range(ActiveSheet.Range("X2")).Top, Breite, Hoehe
Else
'falls nein, wird in Zielzelle eine Fehlermeldung geschrieben
ActiveSheet.Range(ActiveSheet.Range("X2")) = "Bild nicht gefunden"
End If
End Sub
Gruß
M.O.