人员表中输入人名自动提取人员表相同文件夹中的相片

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address(0, 0) = "E3" Then   '按E3单元格的内容提取图片
Dim Rng As Range, Pic As Shape
On Error GOTO AA
Set Rng = Range("J4") '照片提取到的单元格
Path = ThisWorkbook.Path & "\照片\" '图片路径
For Each Pic In Shapes
If Pic.Name Like "*照片" Then Pic.Delete
Next
ActiveSheet.Shapes.AddPicture(Path & Range("E3") & ".JPG", 1, 1, Rng.Left + 10, Rng.Top + 5, 90, 120).Name = Range("E3") & "照片"
EXIT SUB
AA:
ActiveSheet.Shapes.AddPicture(Path & Range("E3") & ".JPG", 1, 1, Rng.Left + 10, Rng.Top + 5, 90, 120).Name = Range("E3") & "照片"'改成你指定的照片
End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

     

    If Target.Address(0, 0) = "E3" Then

        Dim Rng As Range, Pic As Shape

        On Error Resume Next

        Set Rng = Range("J4") '照片单元格

        Path = ThisWorkbook.Path & "\照片\" '图片路径

        For Each Pic In Shapes

            If Pic.Name Like "*照片" Then Pic.Delete

        Next

        If Dir(Path & Range("E3") & ".JPG") <> "" Then '用dir函数测试该人的照片文件是不是存在。

            ActiveSheet.Shapes.AddPicture(Range("E3") & ".JPG", 1, 1, Rng.Left + 10, Rng.Top + 5, 90, 120).Name = Range("E3") & "照片"

        Else

            '假如笑脸的图片存放的文件名为xiaolian.jpg

            ActiveSheet.Shapes.AddPicture(Path & "xiaolian.jpg", 1, 1, Rng.Left + 10, Rng.Top + 5, 90, 120).Name = Range("E3") & "照片"

        End If

    End If

End Sub