1.第一種方法
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
With Image1
Select Case ActiveCell.Address(False, False)
Case "C4"
P = "DC.JPG"
Case "E4"
P = "FG.JPG"
Case "K5"
P = "PR.JPG"
Case Else
.Visible = False
Exit Sub
End Select
.Picture = LoadPicture(ThisWorkbook.Path & "\pic\" & P)
.Visible = True
End With
With ActiveCell
Image1.Top = .Top - Image1.Height / 2
Image1.Left = .Left + .Width
End With
End Sub
2.第二種方法
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 1 Then Exit Sub '如果需要只在第一列输入才产生效果 , 就在代码开头插入一句
'If Target.Count <> 1 Then Exit Sub'全部输入才产生效果 , 就在代码开头插入一句
Dim sPh As String
On Error Resume Next
sPh = ThisWorkbook.Path & "\pic\" & Target.Text & ".jpg"
Target.Comment.Delete
With Target.AddComment
.Visible = True
.Text Text:=""
.Shape.Select True
If Len(Dir(sPh)) Then
With Selection.ShapeRange
.Fill.UserPicture ThisWorkbook.Path & "\pic\" & Target.Text & ".jpg"
.ScaleWidth 1.7, msoFalse, msoScaleFromTopLeft
.ScaleHeight 2, msoFalse, msoScaleFromTopLeft
End With
Else
.Text Text:="找不到指定的图片"
End If
End With
Application.DisplayCommentIndicator = xlCommentIndicatorOnly
End Sub
3.第三種方法
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count <> 1 Then Exit Sub
Dim sPh As String
Dim oCm As Comment
Set oCm = Target.Comment
sPh = ThisWorkbook.Path & "\pic\" & Target.Text & ".jpg"
If Not oCm Is Nothing Then
If Len(oCm.Text) = 0 Or Len(Dir(sPh)) Then oCm.Delete
End If
If Len(Dir(sPh)) Then
With Target.AddComment
.Visible = True
.Text Text:=""
.Shape.Select True
End With
With Selection.ShapeRange
.Fill.UserPicture ThisWorkbook.Path & "\pic\" & Target.Text & ".jpg"
.ScaleWidth 1.7, msoFalse, msoScaleFromTopLeft
.ScaleHeight 4, msoFalse, msoScaleFromTopLeft
End With
Application.DisplayCommentIndicator = xlCommentIndicatorOnly
End If
End Sub 作者: tmtony 时间: 2011-8-27 08:05
赞一个