Makro Bilder automatisch einfügen

[nadia]

Hallo zusammen

Ich habe in Excel ein Makro zum automatisierten Einfügen von Bildern erstellt. Das funktioniert soweit einwandfrei und sieht so aus:

Option Explicit

Sub Bilder_einfügen()
Dim Pfad As String, Wiederholungen As Long
On Error Resume Next
Pfad = "E:\Bilder\"
For Wiederholungen = 2 To Range("A65536").End(xlUp).Row
Cells(Wiederholungen, 3).Activate
ActiveSheet.Pictures.Insert(Pfad & Cells(Wiederholungen, 1) & ".jpg").Select
'MsgBox (Pfad & Cells(Wiederholungen, 1) & ".jpg")
Next
End Sub

Nun werden die Bilder aber leider nur verknüpft und nicht eingebettet. Kann mir jemand sagen, wie ich das Makro ergänzen muss, damit die Bilder eingebettet werden? Sie sollen dabei die Proportionen beibehalten.

Das würde mir die Arbeit wirklich irrsinnig erleichtern. Danke für eure Unterstützung

Liebe Grüsse
Nadia

[Bamberg]

Huhu Nadia,

versuch doch mal Shapes.Addpicture statt Pictures.Insert

Code:

    ActiveSheet.Shapes.AddPicture (Pfad & Cells(Wiederholungen, 1) & ".jpg"), False, True, _

                                  Cells(Wiederholungen, 3).Left, Cells(Wiederholungen, 3).Top, -1, -1

LG Gerd

[Käpt'n Blaubär]

Hallo Nadja,

ich weiß nicht, ob ich Dein Problem richtig verstanden habe,
aber wenn ich ein Bild o.ä. "einbetten" will, dann mache ich das gewöhnlich auf diese Weise:

Option Explicit

Sub Makro1()
' Makro am 15.11.2017 von kph aufgezeichnet

    ActiveSheet.Pictures.Insert("C:\Users\q\Pictures\schloss_x.png").Select
    Selection.ShapeRange.IncrementLeft -282.75
    Selection.ShapeRange.IncrementTop -58.5
End Sub

Sub Makro2()
' Makro am 15.11.2017 von kph aufgezeichnet

    ActiveSheet.Pictures.Insert("C:\Users\q\Pictures\6110491039_7.gif").Select
    Selection.ShapeRange.ScaleWidth 3.42, msoFalse, msoScaleFromTopLeft
    Selection.ShapeRange.ScaleHeight 3.42, msoFalse, msoScaleFromTopLeft
End Sub

übrigens läßt sich sowas ohne jeden Schweißtropfen per Makrorecorder aufzeichnen.
Habe ich gerade auch gemacht, um die obigen Codes zu erzeugen.

Der Weg dahin (je nach Excelversion) etwa:
Einfügen   >   Grafik   >   Aus Datei   >  Bild, Grafik, was auch immer aussuchen,  >  ENTER

[nadia]

Hallo Gerd

Wow vielen Dank für deine rasche Hilfe! Das hat mein Problem gelöst. Genial. Du weisst ja gar nicht wie diese Zeilen mir den Arbeitsalltag erleichtern. Grandios  :19:

Liebe Grüsse

Nadia

[nadia]

Vielen Dank für den Tipp mit dem Makrorecorder Käpt'n Blaubär. Das probiere ich beim nächsten Mal aus. Dieses Problem wurde aber mit den zwei Zeilen aus der anderen Antwort gelöst.

Liebe Grüsse
Nadia

[Zwergel]

Hi Nadia,

nutze für Antworten bitte als Standard den Antwortenbutton und nicht den Zitierbutton. Zitate sind selten nötig. So bleiben Threads kürzer und überschaubarer.