利用Excel VBA实现表格中图片单击放大，单击变小功能

hejiacheng319

    本人平时工作时需要把一些图片放入Excel中，由于Excel本身对图片的处理有些局限性，图片在表格中太小了看不清楚，太大了又影响美观，手动的拉伸与收缩实在是麻烦，所以需要对表格中的图片进行处理已实现图片单击变大，再次单击变小的功能。经过近期对Excel VBA的学习，通过编程实现了这一功能，下面与大家分享一下，希望对遇到同样问题的朋友有所帮助，因为自己是新手，也希望大家多多批评指正。（由于上传文件大小限制图片采用了压缩，Excel及相关过程详见附件）

截图

说明：

         使用时随便插入图片后，鼠标右键单击图片并指定宏到“单击放大”，即可实现功能。

         用两个过程分别描述单击放大图片，再次单击缩小图片的过程，并使这两种过程不断循环下去。

            指定宏之后，由于 application.caller返回调用过程的图片的名称，此时str的值为图片的名称。利用worksheets("sheet1").shapes(str).height对图片高度进行修改（宽度一般会按比例变化）后，使用shape.zorder方法使放大的图片顶置。最后使用shape.onaction属性将图片指定宏到“单击缩小”过程。

icepb

楼主, 只是这个宏好像被破坏了啊. 下载的文件中没有了宏.
是不是也不支持 64位的excel。

enter101

放大倍数如果改一下的话，程序就会报错，不知道为何？

liaoliangbang

Option Explicit

Sub 单击放大()
Dim str As String
str = Application.Caller  '响应的对像（这样理解不知道对不对？）
Worksheets("sheet1").Shapes(str).Height = 5 * Worksheets("sheet1").Shapes(str).Height  '调整（放大）控件高度
Worksheets("sheet1").Shapes(str).ZOrder msoBringToFront  '图形移至顶层（这样理解不知道对不对？）
Worksheets("sheet1").Shapes(str).OnAction = "单击缩小" '指定宏为“单击缩小”
End Sub

Sub 单击缩小()
Dim str As String
str = Application.Caller
Worksheets("sheet1").Shapes(str).Height = 0.2 * Worksheets("sheet1").Shapes(str).Height   '调整（恢复）控件高度
Worksheets("sheet1").Shapes(str).OnAction = "单击放大"  '指定宏为“单击放大”
End Sub