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

HYY514

回复 opelwang 的帖子

试试这种效果 test.rar (398.71 KB, 下载次数: 204)

2011-7-14 13:13 上传

点击文件名下载附件

opelwang

感谢：飞翔 版主指点，不错的方法，学习了。

opelwang

HYY514 发表于 2011-7-14 13:13
回复 opelwang 的帖子

试试这种效果

版主，测试了下代码，效果不错，只是没加容错处理。如果图片不存在或找不到对应的图片，报错。

能否加段容错的代码呀，找不到时，在批注里显示：找不到指定的图片。

谢谢！

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2. If Target.Count <> 1 Then Exit Sub
   
3. Dim sPh As String
   
4. Dim oCm As Comment
   
5. 
   
6.     Set oCm = Target.Comment
   
7.     sPh = ThisWorkbook.Path & "\pic" & Target.Text & ".jpg"
   
8.    
   
9.     If Not oCm Is Nothing Then
   
10.         If Len(oCm.Text) = 0 Or Len(Dir(sPh)) Then oCm.Delete
    
11.     End If
    
12.    
    
13.     If Len(Dir(sPh)) Then
    
14.             With Target.AddComment
    
15.                 .Visible = True
    
16.                 .Text Text:=""
    
17.                 .Shape.Select True
    
18.             End With
    
19.             With Selection.ShapeRange
    
20.                 .Fill.UserPicture ThisWorkbook.Path & "\pic" & Target.Text & ".jpg"
    
21.                 .ScaleWidth 1.7, msoFalse, msoScaleFromTopLeft
    
22.                 .ScaleHeight 4, msoFalse, msoScaleFromTopLeft
    
23.             End With
    
24.             Application.DisplayCommentIndicator = xlCommentIndicatorOnly
    
25.     End If
    
26. 
    
27. End Sub

复制代码

opelwang

Zipall 发表于 2011-7-13 22:38
回复 opelwang 的帖子

Zipall大师，可否加段容错的代码呀？
比如：单击单元格时，找不到对应的图片，或 对应的图片被占用？
如何处理？

Zipall

回复 opelwang 的帖子

我不是什么大师,只是个学习excel的爱好者.

可以在load之前用dir判断文件是否存在.
占用是什么意思?

free1024

学习了。。。

HYY514

opelwang 发表于 2011-7-14 22:59
版主，测试了下代码，效果不错，只是没加容错处理。如果图片不存在或找不到对应的图片，报错。

能否 ...

图片名字不存在时,就直接不显示,这样不好吗?你一个这么大的工作表中除了这个还需要有其他内容吧.
如果真要这样就更简单了
Private Sub Worksheet_Change(ByVal Target As Range)
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 4, msoFalse, msoScaleFromTopLeft
        End With
        
    Else
        .Text Text:="找不到指定的图片"
    End If
End With
Application.DisplayCommentIndicator = xlCommentIndicatorOnly
End Sub

HYY514

如果需要只在第一列输入才产生效果,就在代码开头插入一句
If Target.Column <> 1 Then Exit Sub

opelwang

Zipall 发表于 2011-7-15 09:58
回复 opelwang 的帖子

我不是什么大师,只是个学习excel的爱好者.

占用的意思是：圖片被打開，或被其它的代碼調用。

　　

Zipall

opelwang 发表于 2011-7-15 13:20
占用的意思是：圖片被打開，或被其它的代碼調用。

　　

被其它程序打开时,无法插入吗?