|
除非注明，文章均为 战战如疯 原创，转载请保留链接: http://www./cat4/563.html，VBA交流群273624828。
在之前的文章“VBA制作Excel中图片点击放大和还原的效果”中我们从插入图片开始做了一个图片点击可以放大缩小的特效，但有的朋友在应用中表格是提前做好的，图片也已经插入了，结果就不会用我的那段代码了。那这节我再来讲一下这个问题。
这个的思路就是给图片加一个响应程序，在上篇文章中加响应程序的代码是“Selection.OnAction = "ActionClick"”，如果你的图片已经插入好了只需要这一句就够了。
将下面两段代码分别复制到你做好的表格中
Sub ZhaoPian()
Dim target, sht, rn, mypath, shp, i
For Each shp In Sheets(1).Shapes
shp.OnAction = "ActionClick"
Next
End Sub
Sub ActionClick()
Static n, x
Application.ScreenUpdating = False
If x = Application.Caller Then
n = n + 1
If (n Mod 2) = 1 Then
With Sheet1.Shapes(Application.Caller)
.ScaleHeight 2, msoFalse, msoScaleFromTopLeft
.ScaleWidth 2, msoFalse, msoScaleFromTopLeft
.ZOrder msoBringToFront
End With
Else
With Sheet1.Shapes(Application.Caller)
.ScaleHeight 0.5, msoFalse, msoScaleFromTopLeft
.ScaleWidth 0.5, msoFalse, msoScaleFromTopLeft
.ZOrder msoBringToFront
End With
End If
Else
If (n Mod 2) = 1 Then
With Sheet1.Shapes(x)
.ScaleHeight 0.5, msoFalse, msoScaleFromTopLeft
.ScaleWidth 0.5, msoFalse, msoScaleFromTopLeft
.ZOrder msoBringToFront
End With
With Sheet1.Shapes(Application.Caller)
.ScaleHeight 2, msoFalse, msoScaleFromTopLeft
.ScaleWidth 2, msoFalse, msoScaleFromTopLeft
.ZOrder msoBringToFront
End With
Else
With Sheet1.Shapes(Application.Caller)
.ScaleHeight 2, msoFalse, msoScaleFromTopLeft
.ScaleWidth 2, msoFalse, msoScaleFromTopLeft
.ZOrder msoBringToFront
End With
n = n + 1
End If
x = Application.Caller
End If
Application.ScreenUpdating = True
End Sub
第1段代码就是给表格中所有的图片对象都加个响应的动作,代表当点击图片时就执行”ActionClick“这个程序，第二段代码就是ActionClick了，运行一下第1段代码，你会发现Sheet1表中所有的图片对象都可以响应点击了，就是这么简单。
示例文件下载： http://pan.baidu.com/s/1bnH9zSr 。
|
