图片导出问题

EJR

香川群子 发表于 2012-2-14 16:35
楼主在Excel表格中插入了2万张图片……

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

香川群子 朋友！我绝对不是吃饱了撑的没事干，也不是发神经。是搞研究用的！！！！

EJR

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

我刚刚试过了，您这个代码，对于2万张图片的工作表，只能导出3张来！！！

香川群子

EJR 发表于 2012-2-14 22:42
我刚刚试过了，您这个代码，对于2万张图片的工作表，只能导出3张来！！！

呵呵，我附件中的代码，设置为每按一次按钮，只能导出3张图片：
If cnt = 3 Then Exit Do

你可以自己修改啊。改成100先试试：

If cnt = 100 Then Exit Do

香川群子

代码修改完成。

每次导出100张图片后强制保存一次，然后继续，直到全部图片导出。
好处是，可以强行中断。因为每导出100次就会保存做备份。

1. Sub PicOutput()
   
2. Redo:
   
3.     If Err.Number <> 0 Then Err.Clear
   
4.     n = ActiveSheet.Shapes.Count
   
5.     For i = 1 To n
   
6.         On Error GoTo Redo
   
7.         ActiveSheet.Shapes(i).Select
   
8.         ShpType = Selection.ShapeRange.Type
   
9.         If ShpType = msoPicture Then
   
10.             With Selection
    
11.                 FileName = ThisWorkbook.Path & "" & .Name & ".gif"
    
12.                 .Copy
    
13.                 With ActiveSheet.ChartObjects.Add(0, 0, .Width + 2, .Height + 2).Chart
    
14.                         .ChartArea.Border.LineStyle = 0
    
15.                         .Paste
    
16.                         .Export FileName, "gif"
    
17.                         .Parent.Delete
    
18.                 End With
    
19.                 .Delete
    
20.             End With
    
21.             cnt = cnt + 1
    
22.             m = m + 1
    
23.             i = i - 1
    
24.             If m Mod 100 = 0 Then '这一句代码的保存间隔，可以自己设定调整为任意正整数。
    
25.                 ActiveWorkbook.Save
    
26.                 cnt = 0
    
27.                 GoTo Redo
    
28.             End If
    
29.         End If
    
30.     Next
    
31.    
    
32.     If cnt = 0 Then
    
33.         MsgBox "Total " & m & " Pictures Output OK" & vbCr & _
    
34.                     n & " Shapes Remain, Output Finished !"
    
35.         [a1].Select
    
36.     Else
    
37.         cnt = 0
    
38.         GoTo Redo
    
39.     End If
    
40. End Sub

复制代码

EJR

香川群子 发表于 2012-2-15 11:08
代码修改完成。

每次导出100张图片后强制保存一次，然后继续，直到全部图片导出。

感谢香川群子朋友！哪位帮忙再给个鲜花！！！{:soso_e163:}

guzhen9315

EJR 发表于 2012-2-15 21:46
感谢香川群子朋友！哪位帮忙再给个鲜花！！！

帮你献花了。{:soso_e163:}

MerlynSong

各位前辈，我想咨询一下，导出图片不清晰怎么办

MerlynSong

爱到天涯 发表于 2012-2-9 07:58
已经没有边框了。刚才仔细看了下录制宏，粘贴CHART为对象的时候，大家请注意，新建的CHART对象，默认的边框 ...

前辈，导出的图片不清晰，怎么办