OWRD中如何批量提取图片并按指定名称命名(已解决)

aroffice · 发表于 2024-4-26 16:41

本帖最后由 aroffice 于 2024-4-29 09:31 编辑

我需要从WORD中批量提取出所有的图片，图片的文件名在图片的下方，需要如何操作呢？

谢谢各位的回答，问题已经解决。采用的是定位图片，复制
然后定位到下面的号码，读取剪贴板，保存为JPG格式

Option Explicit
Sub PicOut()
Dim i&, strPath$, strFileName$
strPath = ActiveDocument.Path & "\WORD中批量导出的图片"
If Dir(strPath, 16) = "" Then MkDir strPath
With ActiveDocument
For i = 1 To .InlineShapes.Count
.InlineShapes(i).Select
Selection.Copy '复制选中的图片
With Selection
.Collapse
.MoveDown unit:=wdLine
.MoveEndUntil vbCr
strFileName = strPath & .Range.Text & ".JPG"
End With
If Dir(strFileName) <> "" Then Kill strFileName
SaveClip2Bit (strFileName) '从剪贴板中保存为JPG格式
Next i
End With
MsgBox "ok"
End Sub

复制代码

提取图片按指定名称命名.zip (814.9 KB, 下载次数: 19)

我的图片有点多，结果还是有不能保存的，显示为 Save Picture: (380) - 无效属性值

wanghan519 · 发表于 2024-4-26 17:42

这个word里的回车顺序看不懂啊。。。
但是另存为htm之后倒是能找出图片和文字的对应关系，且图片已经解压出来了，似乎方便一点

gwjkkkkk · 发表于 2024-4-26 20:23

Option Explicit
Sub PicOut()
Dim ar, i&, ImageStream As Object, strPath$, strFileName$

strPath = ThisDocument.Path & "\WORD中批量导出的图片\"
If Dir(strPath, 16) = "" Then MkDir strPath

Set ImageStream = CreateObject("ADODB.Stream")
With ActiveDocument
      For i = 1 To .InlineShapes.Count
         .InlineShapes(i).Select
         With Selection
            .Collapse
            .MoveDown unit:=wdLine
            .MoveEndUntil vbCr
            strFileName = strPath & .Range.Text & ".png"
         End With
         If Dir(strFileName) <> "" Then Kill strFileName
         With ImageStream
            .Open
            .Type = 1
            .Write ActiveDocument.InlineShapes(i).Range.EnhMetaFileBits
            .SaveToFile strFileName
            .Close
         End With
      Next i
End With

Set ImageStream = Nothing
MsgBox "ok"
End Sub

gwjkkkkk · 发表于 2024-4-26 20:24

请参考附件。。。，你这个png其实emf格式。。。

aroffice · 发表于 2024-4-28 09:40

wanghan519 发表于 2024-4-26 17:42
这个word里的回车顺序看不懂啊。。。
但是另存为htm之后倒是能找出图片和文字的对应关系，且图片已经解压 ...

我现在困难的是找出图片与下面的号码的对应关系，如果只要图片，只需要保存为DOCX格式，然后改为ZIP图片里面的图片也可以全部出来的

aroffice · 发表于 2024-4-28 09:42

gwjkkkkk 发表于 2024-4-26 20:24
请参考附件。。。，你这个png其实emf格式。。。

能给解释一下，如何定位图片下的字符串的么？

aroffice · 发表于 2024-4-28 09:49

还有一个问题，有可能会缺少照片，就是本来有照片的地方因为一些系统的原因，没有照片。这种可以解决不？

wanghan519 · 发表于 2024-4-28 09:56

aroffice 发表于 2024-4-28 09:40
我现在困难的是找出图片与下面的号码的对应关系，如果只要图片，只需要保存为DOCX格式，然后改为ZIP图片 ...

保存为htm之后，如上图
图片和下面号码是在一个table里两个相邻的tr行里，而这两者都在width=107的td里
所以保存为htm之后，用图中两句解析html，可以一行行的对应图片和数字
但是感觉没有3楼的方法好，找到图片下移一行选中一行，就得到数字

gwjkkkkk · 发表于 2024-4-28 10:18

aroffice 发表于 2024-4-28 09:42
能给解释一下，如何定位图片下的字符串的么？

大致是遍历图片，选中图片，通过光标移动，对需要的文本进行选择，再进行提取作为文件名。

aroffice · 发表于 2024-4-28 10:31

wanghan519 发表于 2024-4-28 09:56
保存为htm之后，如上图
图片和下面号码是在一个table里两个相邻的tr行里，而这两者都在width=107的td里
...

我试了3楼的方法，现在有个问题，就是中间少了一张照片，后面的所有照片都会错位。而且保存的格式另外需要处理。

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

[已解决] OWRD中如何批量提取图片并按指定名称命名(已解决)

评分

评分

最新热点 /1