导出文件夹内多个Excel文件的图片

前面我们讲过怎么导出Excel工作表中的图片。

那么如何将一个文件夹内的全部Excel中的sheet1工作表的图片导出。

如果sheet1 有多张图片，即命名为“Excel表名（1）,Excel表名（2）”这样循环

效果动态图：

详细VBA源码：

Sub 保存图片()

    Dim MyPath$, myFolder$, myName$

    Dim wb As Workbook, Sh As Worksheet, shp As Shape, m%, n%

    Application.ScreenUpdating = False

    Application.DisplayAlerts = False

    MyPath = ThisWorkbook.Path

    myFolder = MyPath & "\图片\"

    If Len(Dir(myFolder, vbDirectory)) = 0 Then MkDir myFolder

    myName = Dir(MyPath & "\*.xls", vbDirectory)

    Do While myName <> ""

        If myName <> ThisWorkbook.Name Then

            n = 0

            Set wb = Workbooks.Open(MyPath & "\" & myName) 'Filename:=MyPath & "\" & myName '& ".xls" ', Password:=""

            For Each Sh In wb.Sheets

                For Each shp In Sh.Shapes

                    n = n + 1

                    shp.CopyPicture

                    With Sh.ChartObjects.Add(0, 0, shp.Width, shp.Height).Chart

                        .Paste

                        .Export myFolder & myName & "(" & n & ").JPG", "JPG"

                        .Parent.Delete

                    End With

                Next

            Next

            wb.Close savechanges:=False

        End If

        m = m + n

        myName = Dir

    Loop

    MsgBox "保存了 " & m & "张图片"

    Application.DisplayAlerts = True

    Application.ScreenUpdating = True

End Sub

参考至：一指禅62（excelhome）