VBA 自动横向插入图片

amgel2920806449

那位大神帮忙改一下代码


Sub ACC()
Dim i As Integer
Dim path As String
Dim filepath As String
On Error Resume Next
Application.ScreenUpdating = False
path = ThisWorkbook.path
For i = 5 To Range("A65536").End(xlUp).Row
filepath = Dir(path & "\Dino\" & Cells(i, 1).Text & ".*") '
filepath = path & "\Dino\" & filepath
If Dir(filepath) <> "" Then
With ActiveSheet.Range("C" & i)
ActiveSheet.Shapes.AddPicture filepath, False, True, .Left, .Top, .Width, .Height
End With
End If
Next
Application.ScreenUpdating = True
End Sub

liulang0808

Sub ACC()
Dim i As Integer
Dim path As String
Dim filepath As String
On Error Resume Next
Application.ScreenUpdating = False
path = ThisWorkbook.path
For i = 3 To Range("b65536").End(xlUp).Row Step 3
    For j = 2 To Cells(i, Columns.Count).End(xlToLeft).Column
        filepath = Dir(path & "\Dino\" & Cells(i, j).Text & ".*") '
        filepath = path & "\Dino\" & filepath
        If Dir(filepath) <> "" Then
        With ActiveSheet.Cells(i + 1, j)
        ActiveSheet.Shapes.AddPicture filepath, False, True, .Left, .Top, .Width, .Height
        
        End With
        End If
    Next
Next
Application.ScreenUpdating = True

End Sub

liulang0808

。。。。。。。。。。。。。。。

amgel2920806449

liulang0808 发表于 2023-1-10 07:17
Sub ACC()
Dim i As Integer
Dim path As String

谢谢大佬的帮忙