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