Makro fügt Bilder falsch ein

[whizzaaah]

Hallo zusammen,


ich habe ein Makro gebastelt, dass mir Fotos anhand von Zahlen in eine Excel-Vorlage lädt. Das funktioniert eigentlich auch einwandfrei, bis auf dem Punkt das ich die Bilder anschließend nur als Verknüpfung und nicht als Datei eingefügt habe. Dementsprechend fehlen diese, wenn ich die Tabelle versende.


Ich habe schon mehrere Lösung für das Problem gefunden und diese ausprobiert, bekomme es jedoch nicht richtig ans laufen.


Kann mir da vllt. jemand weiterhelfen, dass die Bilder als Dateien und nicht Verknüpfungen eingefügt werden?


Das bisherige Makro sieht wie folgt aus:

---

Code:

Sub Einfügen_Fotos()

    Dim Rw&, PFAD$, Datei$, Bild As Shape
   
    Dim dlgOpen As FileDialog
    Set dlgOpen = Application.FileDialog(FileDialogType:=msoFileDialogOpen)
        With dlgOpen
          .AllowMultiSelect = True
          .Show
        End With
   
    With ActiveSheet
        For Rw = 2 To 1000
            Datei = .Range("H" & Rw) & ".jpg"
            If Dir(PFAD & Datei) <> vbNullString Then
                .Pictures.Insert (PFAD & Datei)
                Set Bild = .Shapes(.Shapes.Count)
                Bild.LockAspectRatio = msoFalse
                Bild.Left = .Range("H" & Rw).Left
                Bild.Top = .Range("H" & Rw).Top
                Bild.Width = 220
                Bild.Height = 150
            End If
          Next
    End With
End Sub

---

Viele Grüße

[Kuwer]

Hallo,

ungetestet:

Sub Einfuegen_Fotos()
    Dim Rw&, PFAD$, Datei$
    Dim dlgOpen As FileDialog
    
    Set dlgOpen = Application.FileDialog(FileDialogType:=msoFileDialogOpen)
    With dlgOpen
      .AllowMultiSelect = True
      .FilterIndex = 3
      .Show
    End With
   
    With ActiveSheet
        For Rw = 2 To 1000
            Datei = .Range("H" & Rw) & ".jpg"
            If Dir(PFAD & Datei) <> vbNullString Then
                With .Shapes.AddPicture( _
                                Filename:=PFAD & Datei, _
                                LinkToFile:=msoFalse, _
                                SaveWithDocument:=msoTrue, _
                                Left:=.Range("H" & Rw).Left, _
                                Top:=.Range("H" & Rw).Top, _
                                Width:=220, _
                                Height:=150)
                    .LockAspectRatio = msoFalse
                End With
            End If
          Next
    End With
End Sub

Warum wird kein Pfad festgelegt?

Gruß Uwe

[whizzaaah]

Funktioniert super, danke!!

Ich habe keinen Pfad festgelegt, weil die Bilder die ich benutze auf nem Server liegen und ständig umsortiert werden, das hat bei mir zu Problemen geführt, die ich mit meinen Kenntnissen nicht so easy umgehen konnte.

Vielen dank und beste Grüße