AW: Bild in Excel einfügen, wenn nicht vorhanden
31.01.2018 18:07:48
Michael
Hallo!
Diese Information ist beim gewöhnlichen Einfügen im Bild-Objekt nicht mehr verfügbar. Du müsstest schon beim Einfügen des Bildes den ursprünglichen Dateinamen irgendwo speichern, damit Du dann beim neuerlichen Einfügen dagegen prüfen kannst. Dafür bietet sich bspw. der "Alternative Text" des Bild-Objektes an - in diesen schreibst Du beim Einfügen den Dateinamen, und beim neuerlichen Einfügen wird zunächst geprüft, ob dieser Dateiname bereits in irgendeinem alternativen Text in den Bild-Objekten des Blattes vorkommt; wenn nein, wird eingefügt (und der Dateiname in den alternativen Text geschrieben), wenn ja wird das neue Objekt gelöscht und somit nicht eingefügt. Als kommentierter Code:
Sub a()
Const BILDPFAD$ = "U:\_Vorlagen\bbrz-reha-logo.png"
Dim Wb As Workbook: Set Wb = ThisWorkbook
Dim Ws As Worksheet: Set Ws = Wb.ActiveSheet
Dim s As Shape, p As Shape, snames As Object, n$
Application.ScreenUpdating = False
Set snames = CreateObject("Scripting.Dictionary")
With Ws
'Die ursprünglichen Dateinamen werden im
'Alternativen Text des Bild-Objekts abgelegt
'Vor jedem Einfügen der Bild-Datei wie o.a.
'werden alle bestehenden Bild-Objekte im Blatt
'durchlaufen und deren gespeicherte, ursprüngliche
'Dateinamen in einem Dictionary gesammelt
For Each s In .Shapes
If Not snames.exists(s.AlternativeText) Then
snames.Add s.AlternativeText, ""
End If
Next s
'Die o.a. Bild-Datei wird zunächst eingefügt
.Pictures.Insert(BILDPFAD).Select
'Aus dem o.a. Pfad wird der Dateiname ermittelt...
n = Mid(BILDPFAD, InStrRev(BILDPFAD, "\") + 1)
'Wenn dieser Dateiname noch nicht in den alternativen Texten
'der bisherigen Bild-Objekte vorkommt, bleibt das neu eingefügte
'Bild-Objekt erhalten und kann formatiert werden...
If Not snames.exists(n) Then
'Gleichzeitig wird dem Bildobjekt der ursprüngliche Dateiname
'in den alternativen Text geschrieben
.Shapes(.Shapes.Count).AlternativeText = n
'hier folgen Formatierungen des Bild-Objekts
Else:
'Wenn der ursprüngliche Dateiname bereits in den alternativen
'Texten der bestehenden Bild-Objekte im Blatt vorkommt wird
'eine entsprechende Meldung angezeigt, und das neue Bild-Objekt
'gelöscht
MsgBox "Bild [" & n & "] schon vorhanden!"
Selection.Delete
End If
End With
Set Wb = Nothing: Set Ws = Nothing: Set s = Nothing
Set p = Nothing: Set snames = Nothing
End Sub
LG
Michael