word图片导出问题

zhanglei1371

gwjkkkkk 发表于 2024-3-21 18:15
Option Explicit
Sub test0() '导图片
    Dim strFileName$, strPath$, n&, strDocName$, shp As Shap ...

您好，请教下，若是Excel或PPT的话，该怎么用xml法进行操作呢？

常扬帆

zhanglei1371 发表于 2024-3-24 20:29
那你上传个大文件试试

传个大文件，麻烦大师们搞定它！太大28mb

gwjkkkkk

excel中可以将图片拷入剪贴板，再转，ppt没玩过。。。

zhanglei1371

gwjkkkkk 发表于 2024-3-24 22:10
excel中可以将图片拷入剪贴板，再转，ppt没玩过。。。

楼上的附件似乎确实不能全部导出，测试只能导出2张。

gwjkkkkk

我试了下，好像也只能导出二个，请坛中大神指点下。。。

gwjkkkkk

excel 中转码，请参考
https://club.excelhome.net/thread-1597743-2-1.html

gwjkkkkk

常扬帆 发表于 2024-3-24 21:00
传个大文件，麻烦大师们搞定它！太大28mb

试了下好像不行啊，搞不定。。。

zhanglei1371

常扬帆 发表于 2024-3-24 21:00
传个大文件，麻烦大师们搞定它！太大28mb

1. Sub word文档图片提取()
   
2. Dim Fso As Object
   
3.     Set Fso = CreateObject("Scripting.FileSystemObject")
   
4.     Fso.CopyFile ActiveDocument.FullName, ActiveDocument.Path & "\test.zip", True
   
5.     If Not Fso.FolderExists(ActiveDocument.Path & "\图片保存") Then MkDir ActiveDocument.Path & "\图片保存"
   
6.     Set oShell = CreateObject("Shell.Application")
   
7.     Set 解压fpobj = oShell.Namespace(ActiveDocument.Path & "\图片保存")
   
8.     If 解压fpobj Is Nothing Then Exit Sub
   
9.     Set oZipFolder = oShell.Namespace(ActiveDocument.Path & "\test.zip\word\media")
   
10.     If (Not oZipFolder Is Nothing) Then
    
11.         解压fpobj.CopyHere oZipFolder.Items, 16
    
12.     End If
    
13.     Kill ActiveDocument.Path & "\test.zip"
    
14. End Sub

复制代码

500M的也不在话下。

常扬帆

zhanglei1371 发表于 2024-3-26 21:46
500M的也不在话下。

准确无误！衷心感谢您！