Bild in Excel einfügen, wenn nicht vorhanden

Forumthread: Bild in Excel einfügen, wenn nicht vorhanden

31.01.2018 14:32:05

Okan

Guten Tag,
ich würde gerne ein Bild per Makro in Excel einfügen. Dabei soll das Makro jedoch vorher prüfen, ob das Bild schon eingefügt ist.
Bis jetzt habe ich nur den teil geschafft, wo ein Bild, mit entsprechendem Rahmen, in Excel eingefügt wird.

Sub Bild()
Range("G7").Select
ActiveSheet.Pictures.Insert( _
"I:\Versuch_Okan\Bilder\" & Cells(1, 1).Value & ".JPG"). _
Select
Selection.ShapeRange.Reflection.Type = msoReflectionTypeNone
Selection.ShapeRange.Height = 226.7716535433
With Selection.ShapeRange.Line
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorAccent1
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = 0
End With
With Selection.ShapeRange.Line
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorText1
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = 0
.Transparency = 0
End With
With Selection.ShapeRange.Line
.Visible = msoTrue
.Weight = 3.5
End With
End Sub

Ich bedanke mich im Voraus.
VG
Okan

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

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

AW: Bild in Excel einfügen, wenn nicht vorhanden

01.02.2018 14:29:03

Okan

Hi Michael,
ich danke dir für die Antwort.
VG
Okan

Gern, lg und owT

01.02.2018 15:07:26

Michael

AW: Bild in Excel einfügen, wenn nicht vorhanden

05.02.2018 09:12:36

Okan

Hi Michael,
ich danke dir für die schnelle Antwort.
VG
Okan

Beliebteste Forumthreads (12 Monate)

Bild in Excel einfügen, wenn nicht vorhanden

Forumthread: Bild in Excel einfügen, wenn nicht vorhanden

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Bild in Excel einfügen, wenn nicht vorhanden

Forumthread: Bild in Excel einfügen, wenn nicht vorhanden

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread