求助！！！如何自动引用文件夹照片（附带资料）

猴子123456

小白求助！！！
1.自动引用图片编程错误（见附件1,2）
2.引用图片后，更换变量，之前引用的图片不能自动删除，全部都为覆盖。

zjdh

Private Sub Worksheet_Change(ByVal Target As Range)
'On Error Resume Next
    Dim pth$, shp As Shape, picarr, x%, Rn As Range
    If Target.Address <> "$B$2" Then Exit Sub
    Set Rn = Range("C3")
    For Each shp In ActiveSheet.Shapes
        If Rn = shp.TopLeftCell Then
            shp.Delete
        End If
    Next
    pth = ThisWorkbook.Path & "\照片" & "\"
    picarr = Array(".jpg", ".jpeg", ".bmp", ".png")
    For x = 0 To UBound(picarr)
        If Dir(pth & Target.Value & picarr(x)) <> "" Then
            With Rn.MergeArea
                ActiveSheet.Shapes.AddPicture Filename:=pth & Target.Value & picarr(x), _
                    LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, _
                    Left:=.Left + 2, _
                    Top:=.Top + 2, _
                    Width:=.Width - 4, _
                    Height:=.Height - 4
            End With
        End If
    Next
End Sub

zjdh

合格证.rar (34.42 KB, 下载次数: 3)

2021-9-1 13:08 上传

点击文件名下载附件