[已解决]点击单元格时显示指定的图片

joyark

被其它程序打开时,无法插入吗?
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

wwy_168

回复 Zipall 的帖子

Zipall 您好
我依葫芦画瓢，新建了一个 my test.xls，但同样的代码在test.xls（是你原始文件）就可以使用，但在my test.xls却不能工作，请帮忙看看。

Zipall

回复 wwy_168 的帖子

打开控件工具箱,插入一个图像控件即可.
你把test.xls切换到设计模式,就能看到那个控件及它的属性设置.

wwy_168

已经搞定，非常感谢，我正在做一个PCB库文件与图片相对应，增加了一些异常的事件。文件在公司，待做得差不多，再发出来分享。

joyark

回复 wwy_168 的帖子

工作表插以下
圖片會自動
=EMBED("Forms.Image.1","")

wwy_168

回复 joyark 的帖子

谢谢，已经搞定。很多人只用到excel极少的功能，VBA是否是就是增加excel的利器！

wwy_168

回复 joyark 的帖子

谢谢你加我为好友，可能是我的权限不足，无法同意加你为好友

BAIXINGR

学习下

凉皮

学习一下啊，一步一步来。

Iweb002

收获源自积累，坚持终能成长！