前面我们讲过怎么导出Excel工作表中的图片。那么如何将一个文件夹内的全部Excel中的sheet1工作表的图片导出。如果sheet1 有多张图片,即命名为“Excel表名(1),Excel表名(2)”这样循环
效果动态图:
1504684544104451.gif
详细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 = TrueEnd Sub
参考至:一指禅62(excelhome) |