图片导出问题

香川群子 · 发表于 2012-2-13 13:45

楼主，2万多张图片的话，用For……Each……循环要出事的恩啦。

你先做个备份，
然后，改用for next 循环，
让宏每次只导出100张图片，并且导出一张就删除一张。
然后保存文件。

然后，继续。

这样，估计可以改善速度的。

EJR · 发表于 2012-2-13 14:36

本帖最后由 EJR 于 2012-2-13 14:41 编辑

香川群子发表于 2012-2-13 13:45
楼主，2万多张图片的话，用For……Each……循环要出事的恩啦。

你先做个备份，

我不明白您说的意思，能详细一些吗？改用for next 循环，怎么修改代码？

导出一张删除一张，是一点一点的减少，解决不了开始是2万张的实际啊！
最后导出后100张，因为被删除了2万减去100张，是实在的100张，可最初导出100张时，工作表中还是2万张啊？？

liucqa · 发表于 2012-2-13 14:48

EJR 发表于 2012-2-13 14:36
我不明白您说的意思，能详细一些吗？改用for next 循环，怎么修改代码？

至少可以保证后面导出速度加快呀。

你在excel里面插入2万个图片，没死机已经不错了

EJR · 发表于 2012-2-13 16:52

liucqa 发表于 2012-2-13 14:48
至少可以保证后面导出速度加快呀。

你在excel里面插入2万个图片，没死机已经不错了

2万个图片就死机？E2007里可是能有114万行啊！！！？？？

是软件弄着玩的？

香川群子 · 发表于 2012-2-13 17:10

上了个代码，你试试看：

Sub PicOutput()
Do
'MsgBox ActiveSheet.Shapes.Count
i = i + 1
On Error GoTo Ext '循环到出错时(无法正常选择时)退出。
ActiveSheet.Shapes(i).Select
ShpType = Selection.ShapeRange.Type
If ShpType = msoPicture Then
With Selection
FileName = ThisWorkbook.Path & "" & .Name & ".gif"
.Copy
With ActiveSheet.ChartObjects.Add(0, 0, .Width + 2, .Height + 2).Chart
.ChartArea.Border.LineStyle = 0
.Paste
.Export FileName, "gif"
.Parent.Delete
End With
.Delete
End With
cnt = cnt + 1
If cnt = 100 Then Exit Do '可以在这里改变退出循环的次数
End If
’[a1].Select
Loop
ActiveWorkbook.Save '是否需要保存自己决定。我想是保存比较好，可以从新的起点开始。
Ext:
If cnt > 0 Then
MsgBox cnt & " Pictures Output OK" & vbCr & "Check Again until cnt=0 !"
Else
MsgBox "No more Pictures Remains, Output Finished !"
'考虑到有其它控件等存在干扰，请检查直到没有新的图片导出时为止。
End If
End Sub

复制代码

附件为测试例子：

EJR · 发表于 2012-2-14 09:12

本帖最后由 EJR 于 2012-2-14 09:15 编辑

香川群子发表于 2012-2-13 17:10
上了个代码，你试试看：附件为测试例子：

非常感谢香川群子朋友！在试验前先感谢你了。
{:soso_e163:}{:soso_e163:}{:soso_e163:}{:soso_e163:}{:soso_e163:}{:soso_e163:}

教教我怎么给你鲜花啊？

EJR · 发表于 2012-2-14 11:23

EJR 发表于 2012-2-14 09:12
非常感谢香川群子朋友！在试验前先感谢你了。
{:soso_e163: ...

"你现在积分才269分，还没有这个权限，当你的积分达到1100分时（等级就是高级），右下方就出现“评分”按钮。点击就可以评分。"
刚知道我不能评分。遗憾！

香川群子 · 发表于 2012-2-14 16:35

楼主在Excel表格中插入了2万张图片……

这个，如果不是上当受骗，那就是发神经。呵呵。

…………
而且，现在又要把Excel中的图片导出来……吃饱了撑的没事干对吧。

因为某种原因，无法找到原来导入图片时的图片源文件了。呵呵，悲催哦，楼主。

…………

当然，如果作为VBA代码爱好者的研究，那就是另外回事了。

guzhen9315 · 发表于 2012-2-14 19:30

祝大家情人节快乐!{:soso_e163:}

EJR · 发表于 2012-2-14 22:32

EJR 发表于 2012-2-14 11:23
"你现在积分才269分，还没有这个权限，当你的积分达到1100分时（等级就是高级），右下方就出现“评分”按 ...

非常感谢liucqa 给鲜花

		自动登录	找回密码
密码			免费注册

[求助] 图片导出问题

点评

评分

点评