VBA代码模块，EXCEL图片一键批量另存为

最新推荐文章于 2024-06-18 13:59:47 发布

baojie5826

最新推荐文章于 2024-06-18 13:59:47 发布

阅读量2.7k

点赞数 2

原文链接：http://blog.51cto.com/mflag/2412185

版权

VBA代码模块，EXCEL图片一键另存为

Sub Opiona()

'On Error Resume Next    '// 发生错误，自动执行下一句，就是忽略错误
Application.ScreenUpdating = False '//关闭屏幕刷新
Application.DisplayAlerts = False '//关闭系统提示
t = Timer   '//开始时间
For Each shap In ActiveSheet.Shapes  '//循环所有图片
    Set Rng = shap.TopLeftCell  '//Range 对象，它代表位于指定对象左上角下方的单元格
    'MsgBox shap.Name & "--" & Rng.Address
    shap.Copy  '//复制图片
       With ActiveSheet.ChartObjects.Add(0, 0, shap.Width, shap.Height).Chart  '//建立一个新图片
            .Paste  '//将复制的图片放进去
            .Export ThisWorkbook.Path & "/" & Range(Rng.Address).Value & ".JPG"  '//导出为图片格式，如JPG，GIF
            .Parent.Delete   '//删除自己建立的图片
        End With
Next
Application.ScreenUpdating = True '//恢复屏幕刷新
Application.DisplayAlerts = True '//恢复系统提示
MsgBox "一共用时：" & Format(Timer - t, "#0.0000") & " 秒"  '//提示所用时间
End Sub