求助，excel自动获取文件夹对应图片

2338171

求助，excel自动获取文件夹对应图片，自适应表格（拉伸填充满表格），里面有效果

liulang0808

https://club.excelhome.net/threa ... tml?_dsign=15791c27
链接内容请参考

2338171

liulang0808 发表于 2023-4-13 20:59
https://club.excelhome.net/thread-1441877-1-1.html?_dsign=15791c27
链接内容请参考

您好，VBA新手，两个问题，1怎么确定导入照片的区域？2要导入的当前文件名的文件夹怎么写（比如：EXCEL文件名为22，导入22文件夹里的对应照片）？

2338171

liulang0808 发表于 2023-4-13 20:59
https://club.excelhome.net/thread-1441877-1-1.html?_dsign=15791c27
链接内容请参考

Sub addpicture()
    Set fso = CreateObject("Scripting.FileSystemObject")
    Application.ScreenUpdating = False
    For Each shp In ActiveSheet.Shapes
        If shp.Type = 13 Then shp.Delete
    Next shp
    For j = 3 To 13 Step 5
        For i = 2 To Cells(Rows.Count, 1).End(3).Row Step 11
            Cells(i, j).Select
            Set rng = Selection
            str1 = ThisWorkbook.Path & "\插入图片" & Cells(i, j - 1) & ".jpg"
            If fso.FileExists(str1) Then
                ActiveSheet.Pictures.Insert(str1).Select
                With Selection
                    .ShapeRange.LockAspectRatio = msoFalse
                    .Left = rng.Left + 1
                    .Top = rng.Top + 1
                    .Width = rng.Offset(0, 1).Left - rng.Left - 2
                    w = rng.Offset(1, 0).Top
                    y = rng.Top
                    .Height = w - y - 2
                End With
            End If
        Next i
    Next j
    Application.ScreenUpdating = True
End Sub