怎样用VBA将所有EXCEL中的图片保存到另一个文件夹！

lovexia520

mhps159357 发表于 2019-3-11 21:54
你看我的运行后是这样的，一点问题没有！

好的，谢谢！我再试试！

changhong8

加一句红色的代码试试，我以前也出现过导出来是空白的：手动调试没问题，一次执行就出问题了，最后估计是执行速度太快没跟上，你试试下面的
Sub CC()
Dim st$, shp As Shape
Application.ScreenUpdating = False
Application.DisplayAlerts = False
st = Dir(ThisWorkbook.Path & "\*.xls?")
Do While st <> ""
If st <> ThisWorkbook.Name Then
Workbooks.Open (ThisWorkbook.Path & "\" & st)
For Each shp In Workbooks(2).Sheets("照片和宗地图").Shapes
k = k + 1
shp.Copy
With ChartObjects.Add(0, 0, shp.Width, shp.Height).Chart
.parent.select
.Paste
.Export ThisWorkbook.Path & "\" & Workbooks(2).Sheets("照片和宗地图").Cells(3, 2).Value & "+" & k & ".png"
.Parent.Delete
End With
Next
Workbooks(2).Close
End If
k = 0
st = Dir
Loop
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

lovexia520

mhps159357 发表于 2019-3-11 20:52
你再试试？

感谢大神悉心帮助，找出问题所在了，其实是你的EXCEL版本跟我的不一样，我换低版本EXCEL就解决掉了！谢谢！

lovexia520

changhong8 发表于 2019-3-11 22:49
加一句红色的代码试试，我以前也出现过导出来是空白的：手动调试没问题，一次执行就出问题了，最后估计是执 ...

加上.Parent.Select这么一段代码确实可以解决高版本（EXCEL2016版）中导出变空白问题，非常感谢，大神无处不在！

ehxfy

.Paste  后面加一个延时，似乎也可以
Savetime = Timer
While Timer < Savetime + 2
DoEvents
Wend

考试加油站

学习了，谢谢

仙女配凡人

学习