0
Ich versuche, ein Bild mit VBA einzufügen, aber der Code verbindet nur das Bild in das Excel-Blatt. Sobald ich die Bilder lösche, werden die verknüpften Bilder im Blatt gelöscht. Ich muss den Code anpassen, um das verknüpfte Bild in der Arbeitsmappe zu speichern. Dies ist der Code IEinfügen von Bildern mit VBA
Sub DeleteImages()
For Each s In ActiveSheet.Shapes
s.Delete
Next s
ActiveSheet.Cells.Rows.AutoFit
End Sub
Sub AddImages()
Dim sImgFile As String
sPath = ActiveWorkbook.Path & Application.PathSeparator
Set ws = ActiveSheet
ltop = Val(InputBox("Provide height", "Height"))
'lwid = Val(InputBox("Provide width", "Width"))
'On Error GoTo StopIt
If ltop > 0 Then 'And lwid > 0
ws.Range("E1").ColumnWidth = 1
For l = 2 To ws.Range("A" & Rows.Count).End(xlUp).Row
ws.Range("A" & l).Rows.AutoFit
sImgFile = Dir(sPath & ws.Range("B" & l).Value & ".*")
If sImgFile <> "" Then
With ws.Pictures.Insert(sPath & sImgFile)
With .ShapeRange
.LockAspectRatio = msoTrue
'.Width = lwid
.Height = ltop
i = 1
ws.Range("E" & l).ColumnWidth = Application.WorksheetFunction.Max(.Width/5.3, ws.Range("E" & l).ColumnWidth)
ws.Range("E" & l).RowHeight = .Height + 4
End With
.Left = ws.Cells(l, 5).Left
.Top = ws.Cells(l, 5).Top + 2
.Placement = 1
.PrintObject = True
Call Macro1(Range("E" & l))
End With
End If
Next l
End If
For Each s In ActiveSheet.Shapes
s.Left = ws.Range("E1").Left + (ws.Range("E1").Width - s.Width)/2
Next s
StopIt:
On Error GoTo 0
End Sub
Gibt es einen Grund, warum Sie nicht das Bild als Form hinzufügen könnte? –
Ich habe versucht, diesen Code ein: Wenn sImgFile <> "" Dann Mit ws.Shapes.AddPicture (sPath & sImgFile, LinkToFile: = msoFalse, _ Savewithdocument: = msoCTrue) Mit .ShapeRange .LockAspectRatio = msoTrue ‘.Width = lwid .Height = ltop i = 1 ws.Range ("E" & l) .ColumnWidth = Anwendung.WorksheetFunction.Max (.Width/5.3, ws.Range ("E" & l) .ColumnWidth) ws.Range ("E" & l) .RowHeight = .Height + 4 – paul
aber es kommt zu einem Fehler – paul