'自动插入图片  
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