Excel图片批量导出VBA代码(有代码)

本文是教大家如何导出Excel里的图片和一些小操作，冻结屏幕刷新、状态栏动态显示程序进度以及如何创建文件夹等。废话不说，上代码。

Sub 导出()

Application.ScreenUpdating = False

Dim strPath$, i&, ad$, sh, cht

On Error Resume Next

MkDir ThisWorkbook.Path & "\pic\"

strPath = ThisWorkbook.Path & "\"

For Each pic In ActiveSheet.Shapes

js = js + 1

If pic.Name <> "按钮" Then

ad = pic.TopLeftCell.Address

pic.Select

pic.CopyPicture

Set cht = ActiveSheet.ChartObjects.Add(0, 0, 50, 50)

With cht

.Chart.ChartArea.Select

.Chart.Paste

.Chart.Shapes(1).Height = 50

.Chart.Shapes(1).Width = 50

.Chart.Export (strPath & "pic\" & Range(ad).Offset(0, -1).Value & ".jpg")

.Delete

End With

End If

DoEvents

Application.StatusBar = "正在处理 " & Format(js / ActiveSheet.Shapes.Count, "0.00%")

Next

MsgBox "ok!"

Application.StatusBar = ""

Application.ScreenUpdating = True

End Sub

代码的视频解说去我的视频集合里找就好了。

代码的文件在这里：链接: https://pan.baidu.com/s/1KM47Y5MvsuV1bejzvzxaQg?pwd=ccf8 提取码: ccf8