Bilder einfügen

[michael9292]

Hallo zusammen

Ich habe mit dem Befehl Picture insert Bilder in mein Excel eingefügt. Diese werden aber nur verlinkt.
In den neueren Versionen muss man ja Shapes.AddPicture verwenden um die Bilde rin der Datei zu speichern. 

Jetzt habe ich das Problem das die Verschiebung der Bilder mit AddPicture nicht mehr funktioniert.

Meine Bilder sind immer im gleichen System abgespeichert.
Bsp. Dateiname: Ablauf Detangle_erc_1_1-1   Dateiname (wird vom Benutzer angegeben)Bezeichnung Ablauf (weniger wichtig) Ablaufnummer (Verschiedene Tabellenblätter) Spaltenzahl Zeilenzahl
Die Anordnung passiert in einer For Schlaufe. Je nach Zeilen und Spaltenposition werden die Bilder nach dem einfügen ausgerichtet.
Dies sollte jetzt auch mit dem neuen Befehl funktionieren.

Unten der Code wie er mit Picture insert funktioniert.
Im Anhang 4 Bsp Bilder und die Excel Datei.

danke schon im voraus für die Hilfe.

Code:

Sub einfügen()
'
'

    Dim w As Integer
   Dim i As Integer
   Dim s As Integer
   Dim ws As String
   Dim strDatei

'    pfad = "E:\DATA\protocol"
   
   For w = 1 To 10
   For s = 0 To 10
    For i = 0 To 10
    strDatei = pfad & "\" & Dateiname & "_erc_" & w & "_" & s & "-" & i & ".png"
    If Dir(strDatei, vbNormal) <> "" Then
      ws = Worksheets(w).Name

    With Worksheets(ws).Pictures.Insert(strDatei)
       .Width = 225#
       .Top = Worksheets(ws).Cells(1 + (20 * i), 1).Top
       .Left = Worksheets(ws).Cells(1, 1 + (4 * s)).Left
       .ShapeRange.IncrementLeft -15 * s

    End With
   Else

   End If

    Next i
    Next s
    Next w


       For s = 0 To 10
       For i = 0 To 10
   strDatei = pfad & "\" & Dateiname & "_imm_ 1_" & s & "-" & i & ".png"
   If Dir(strDatei, vbNormal) <> "" Then
      ws = Worksheets(5).Name

    With Worksheets(ws).Pictures.Insert(strDatei)
       .Width = 349#
       .Top = Worksheets(ws).Cells(1 + (31 * i), 1).Top
       .Left = Worksheets(ws).Cells(1, 1 + (5 * s)).Left
       .ShapeRange.IncrementLeft 3.75 * s
    End With
   Else

   End If

    Next i
   Next s


   For s = 0 To 10
       For i = 0 To 10
    strDatei = pfad & "\" & Dateiname & "_imm_ 2_" & s & "-" & i & ".png"
    If Dir(strDatei, vbNormal) <> "" Then
      ws = Worksheets(6).Name

    With Worksheets(ws).Pictures.Insert(strDatei)
       .Width = 304#
       .Top = Worksheets(ws).Cells(1 + (27 * i), 1).Top
       .Left = Worksheets(ws).Cells(1, 1 + (5 * s)).Left
       .ShapeRange.IncrementLeft 3.75 * s
    End With
   Else

   End If

    Next i
   Next s
   
   
   For i = 1 To 6
   ws = Worksheets(i).Name
   With Worksheets(ws)
   .PageSetup.CenterHeader = Ersteller
   .PageSetup.LeftHeader = Datensatznummer
   End With
   Next i
   
   
   
   
   
   
    End Sub

[schauan]

Hallöchen,

bei mir funktioniert das mit Picture.Insert auch in 2016 pro.

[michael9292]

Funktionier auch, aber die Bilder werden verlinkt und nicht ins Excel abgespeichert. Dies fürt dazu dass wenn mann die Originalbilder löscht, das diese nicht mehr angezeigt werden.