利用VBA为Excel开启图片自动缩放功能

操作演示Gif

Dim d As ObjectSub 开启放大图片功能()   Set d = CreateObject("scripting.dictionary")   Dim pic As Shape   Dim sht As Worksheet   For Each sht In ActiveWorkbook.Worksheets       For Each pic In sht.Shapes           If pic.Type = msoPicture Then               pic.OnAction = "点击放大或缩小图片"               d(pic.Name) = 0           End If       Next   NextEnd Sub

Sub 取消放大图片功能()   Dim pic As Shape   Dim sht As Worksheet   For Each sht In ActiveWorkbook.Worksheets       For Each pic In sht.Shapes           If pic.Type = msoPicture Then               pic.OnAction = ""               d(pic.Name) = 0           End If       Next   NextEnd Sub

Sub 点击放大或缩小图片()   Dim picName As String   picName = Application.Caller   Dim pic As Shape   Set pic = ActiveWorkbook.ActiveSheet.Shapes(picName)   If d(pic.Name) = 0 Then       pic.Width = pic.Width * 1.5       pic.Height = pic.Height * 1.5       d(pic.Name) = 1   Else       pic.Width = pic.Width / 1.5       pic.Height = pic.Height / 1.5       d(pic.Name) = 0   End IfEnd Sub

>>获取方式<<

点亮屏幕右下方的「赞」 和「推荐」 ；

在公众号后台发送关键字“图片缩放”，即可获取资源文件。（人工回复，请稍等一会~）

>>推荐阅读<<

★★★查看更多的内容★★★