根据姓名自动插入照片

6739912

在F3单元格输入姓名后，自动将特定文件下的同名照片插入G4合并单元格，且填充满合并单元格,如果没有照片，单元格显示无照片

求大神帮忙

gwjkkkkk

请参考。。。

liulang0808

https://club.excelhome.net/threa ... tml?_dsign=15791c27
可以参考

6739912

二楼代码会出现两个问题，1、不能删除已有的图片；2、插入图片位置不对
现修改如下：

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim strFileName$, strPath$, shp As Shape
    If Target.Address <> "$F$3" Then Exit Sub
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set SH = Sheets("Sheet1")
   
    Application.ScreenUpdating = False
    strPath = ThisWorkbook.Path & "\照片\"
    strFileName = Dir(strPath & Target.Value & ".jpg")
    For Each shp In ActiveSheet.Shapes
        shp.Delete
    Next
    If strFileName <> "" Then [G3].Select
    If FSO.FileExists(strPath & strFileName) = True Then
       SH.Pictures.Insert(strPath & strFileName).Select
       ActiveSheet.Hyperlinks.Add Anchor:=Selection.ShapeRange.Item(1), Address:=strPath & strFileName
       With Selection
           .Placement = xlMoveAndSize
           .ShapeRange.LockAspectRatio = msoFalse
           .Top = ActiveCell.Top + 5
           .Left = ActiveCell.Left + 5
           .Height = ActiveCell.Height * 2
           .Width = ActiveCell.Width * 6
      End With
      [G3].Value = strFileName
    Else
      Application.EnableEvents = False
      [G3].Value = "无照片"
      Application.EnableEvents = True
    End If
    Application.ScreenUpdating = True
End Sub

6739912

shp.type=13