'自动插入图片
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Target.Column = 1 And Target.Row > 1 Then '第一列的时候才触发
For Each sp In Me.Shapes
If sp.TopLeftCell.Offset(0, -1) = Target Then
sp.Delete '删除单元格中原有的图片
End If
Next
p = ThisWorkbook.Path & "\图片\" '图片所在文件夹
f = p & Target & ".jpg" '要插入图片的名称
Set rg = Target.Offset(0, 1) '要插入图片的位置
If Dir(f) <> "" Then
rg.Value = ""
Me.Shapes.AddPicture f, ture, ture, _
rg.Left + 5, rg.Top + 5, _
rg.Width - 10, rg.heithg - 10
ElseIf Target <> "" Then
rg.Value = "No Picture" '图片名称不存在时,显示无图片
Else
rg.ClearContents '图片名称为空时清除图片单元格内容
End If
End If
End Sub