Verhalten beim Einfügen von Bildern per Makro

Markus1201 · 7. Juli 2020

Hallo zusammen,

ich habe folgendes Makro:

Sub InsertPics

Dim Rw&, PFAD$, Datei$, Bild As Shape

PFAD = "C:\Users\….\"
With ActiveSheet
For Rw = 2 To 10000
Datei = .Range"C" & Rw & ".bmp"
If DirPFAD & Datei <> vbNullString Then
.Pictures.Insert PFAD & Datei
Set Bild = .Shapes.Shapes.Count
Bild.LockAspectRatio = msoFalse
Bild.Left = .Range"B" & Rw.Left
Bild.Top = .Range"B" & Rw.Top
Bild.Width = .Range"B" & Rw.Width
Bild.Height = .Range"B" & Rw.Height
End If
Next
End With
End Sub

Bilder werden abhängig von der Artikelnummer in die jeweilige Zelle eingefügt und die Größe angepasst.

Das Problem ist, dass die Bilder nur als Verknüpfung eingefügt werden und somit immer eine Verbindung zum Laufwerk bestehen muss.

Wie kann ich das Makro abändern, damit die Bilder in die Excel-Datei dauerhaft eingefügt werden?

Danke im Voraus.

Dirk Kampfmeier

Hallo Stefan,

stimmt, Excel 2003 ist schneller bei Shapes. Es hat sich ja beim Wechsel auf Excel 2007 einiges bei Shapes und Charts getan (Transparenz, Schatten und weitere Effekte).

Gruß, Dirk

PS: Application.DoEvents gibt es eigentlich gar nicht und müsste zu einem Kompilierfehler führen. Hast du "Option Explicit" oben im Modul stehen?

Dirk Kampfmeier

Hallo Stefan,

versuch mal nach AddPicture den Befehl DoEvents, damit müsste es ohne Hänger klappen.

Ansonsten kannst du weitere Eigenschaften nach dem Hinzufügen (und nach DoEvents) einstellen: z.B. pic3.Rotation = 90

Set pic3 = ActiveSheet.Shapes.AddPicture(Filename:=xBildpfad_komplett, LinkToFile:=False, SaveWithDocument:=True, Left:=ActiveCell.Left, Top:=ActiveCell.Top, Width:=ActiveCell.Width, Height:=ActiveCell.Height)

DoEvents

pic3.Rotation = 90

Gruß Dirk

Andreas Killer

Könntest du da noch helfen?

Denke schon.

Ersetze die Zeile

Set Sh = InsertPicture(Datei, R)

durch

Set Sh = InsertPicture(Datei, R.Offset(, -1), LockAspectRatio:=False)

Andreas.

Andreas Killer

Sub InsertPics()

 Dim R As Range

 Dim Pfad As String, Datei As String

 Dim Sh As Shape

 Pfad = "C:\Users\…\"

 Application.ScreenUpdating = False

 For Each R In Range("C2", Range("C" & Rows.Count).End(xlUp))

 Datei = Pfad & R & ".bmp"

 If Dir(Datei) <> "" Then

 Set Sh = InsertPicture(Datei, R)

 End If

 Next Application.ScreenUpdating = TrueEnd Sub

Private Function InsertPicture(ByVal FName As String, ByVal Where As Range, _

 Optional ByVal LinkToFile As Boolean = False, _

 Optional ByVal SaveWithDocument As Boolean = True, _

 Optional ByVal LockAspectRatio As Boolean = True) As Shape

 'Inserts the picture file FName as link or permanently into Where

 Dim S As Shape, SaveScreenUpdating, SaveCursor

 SaveCursor = Application.Cursor

 SaveScreenUpdating = Application.ScreenUpdating

 Application.Cursor = xlWait

 Application.ScreenUpdating = False

 With Where

 'Insert in original size

 Set S = Where.Parent.Shapes.AddPicture( _

 FName, LinkToFile, SaveWithDocument, .Left, .Top, -1, -1)

 'Keep the proportions?

 S.LockAspectRatio = LockAspectRatio

 'Scale it to fit the cell

 S.Width = .Width

 If S.Height > .Height Or Not LockAspectRatio Then S.Height = .Height

 'Move it to the middle of the cells

 If S.Width < Where.Width Then S.Left = Where.Left + (Where.Width - S.Width) / 2

 If S.Height < Where.Height Then S.Top = Where.Top + (Where.Height - S.Height) / 2

 End With

 Set InsertPicture = S

 Application.Cursor = SaveCursor

 Application.ScreenUpdating = SaveScreenUpdating

End Function

Claus Busch

Hallo Markus,

ich habe den Code getestet und bei mir fügt er alle Bilder ein. Zum Testen musste ich den Code ändern auf ".jpg".

Kontrolliere mal die Dateiendung deiner Bilder.

Die eingefügte Kopie ist keine Verknüpfung mehr. Auch das habe ich getestet.

Claus

Hi,

willkommen im Windows Forum!

Verhalten beim Einfügen von Bildern per Makro - Similar Threads - Verhalten Einfügen Bildern	Forum	Datum
Wie entferne ich automatische Unterstreichung von Bildern beim Einfügen in Word? Wie entferne ich automatische Unterstreichung von Bildern beim Einfügen in Word?: Wie entferne ich automatische Unterstreichung von Bildern beim Einfügen mittels strg+v in Word?	Microsoft Office	25. Oktober 2024
Bild per Makro löschen Bild per Makro löschen: Hallo zusammen, ich habe eine Frage zu einem Vba Code. Und zwar möchte ich per Vba Code ein Bild aus einem OneDrive Ordner löschen. Das ist mein Code:Sub kill Dim KillFile As String KillFile =...	Microsoft Office	17. Dezember 2021
Bild einfügen Bild einfügen: Ich möchte in eine Adresse vo Windows Mail ein Bild einfügen?	Windows Live Essentials	1. Mai 2021
Bilder einfügen Bilder einfügen: Wieso sind die Einfüge Optionen für Bilder bei der Standard App gesperrt?	Microsoft Office	27. Januar 2020
Screenshot aus Zwischenablage per VBA-Marko in Bild-Steuerelement einfügen Screenshot aus Zwischenablage per VBA-Marko in Bild-Steuerelement einfügen: Hallo Zusammen, für eine PowerPoint-Vorlage benötige ich ein VBA-Makro, mit dem ich ein Screenshot aus der Zwischenablage in ein Bild-Steuerelement einfügen kann. Die Präsentation sollte dabei...	Microsoft Office	15. März 2019
Ungültiger Dateipfad beim Einfügen von Bildern in Word 2016 Ungültiger Dateipfad beim Einfügen von Bildern in Word 2016: Hallo, Word greift beim Einfügen eines Bildes in ein Word-Dokument auf einen Dateipfad zu, der nicht existiert und zeigt die Fehlermeldung: "Netzwerkfehler. Auf \\HAWISDESKTOP\Pictures konnte...	Microsoft Office	31. August 2017
Bilder werden nicht dargestellt beim einfügen Bilder werden nicht dargestellt beim einfügen: Seid einigen Wochen habe ich die Herausforderung, dass keine Bilder angezeigt werden welche ich einfüge. Man sieht nur den Rahmen und der Rest ist weiß. Bei fertigen PPT mit Bildern muss ich...	Microsoft Office	5. Mai 2017

Verhalten beim Einfügen von Bildern per Makro