如何用vba把word中的图片导出为独立的图片格式文件?

在word中的图形对象有InlineShape对象和Shape对象,其中InlineShape对象表示的是嵌入到文本层的图片,就像是文字的一部分一样,而Shape对象是悬浮于文本之上位于图形层,两者有区别。

如果想要把所有的图形对象导出为独立的图片格式文件,可以借组EnhMetaFileBits属性。

EnhMetaFileBits属性返回的是把word中的选择区域当做是一个图片,然后返回该图片的增强型图元文件字节流。

它相当于API函数GetEnhMetaFileBits ,由于增强型图元文件的文件格式默认是emf,所以在将字节流保存为图片时,默认指定扩展名为emf。

以下代码可以实现将word中的各种图形导出为独立的图片格式的

vbnet 复制代码
Sub QQ527524938()
    Const adTypeBinary = 1
    '默认文本数据
    Const adTypeText = 2
    '指定保存到文件时不覆盖,只新建
    Const adSaveCreateNotExist = 1
    '指定保存到文件时覆盖原文件,没有则新建
    Const adSaveCreateOverWrite = 2
    Dim oStream As Object
    Dim arr() As Byte
    Set oStream = VBA.CreateObject("adodb.stream")
    i = 1
    Dim oDoc As Document
    Set oDoc = Word.ActiveDocument
    Dim oSP As Shape
    Dim sPath As String
    sPath = oDoc.Path & "\"
    Dim oInLineSp As InlineShape
    With oDoc
        For Each oSP In .Shapes
            oSP.Select
            arr = Word.Selection.EnhMetaFileBits
            With oStream
                .Open
                .Type = adTypeBinary
                .Write arr
                .SaveToFile sPath & i & ".emf", adSaveCreateOverWrite
                .Close
            End With
            i = i + 1
        Next
        For Each oInLineSp In .InlineShapes
            arr = oInLineSp.Range.EnhMetaFileBits
            With oStream
                .Open
                .Type = adTypeBinary
                .Write arr
                .SaveToFile sPath & i & ".emf", adSaveCreateOverWrite
                .Close
            End With
            i = i + 1
        Next
    End With
End Sub

文件。

相关推荐
Metaphor69217 小时前
使用 Python 在 Word 文档中添加或删除文本框
python·word
Sunflower023 天前
如何解决word/WPS word 中表格跳到下一页(上一页有大篇幅空白)
word·wps
AI导出鸭4 天前
如何让deepseek生成word文档 ?「AI 导出鸭」苹果版:从API流式解析到Pages级渲染,硬核攻克公式裂变与表格回流的终极方案。
人工智能·chatgpt·word·cocoa·ai导出鸭
开开心心就好4 天前
Word双击预览图片插件弥补Word功能缺失
人工智能·python·智能手机·ocr·电脑·word·音视频
VBA63374 天前
如何学习VBA之2.1.3 VBA的错误处理
vba
一棵星5 天前
内网 MySQL 表结构一键导出 Word 文档:直连 + Agent 双模式实战
数据库·mysql·word
bug嘛我经常写5 天前
如何批量删除word文档中存在的无用样式
经验分享·python·word
Am-Chestnuts5 天前
Kimi长回答批量导出Word:DS随心转实践
word
曹牧6 天前
Word:更改列表级别
word
wtsolutions7 天前
Sheet-to-Doc Skill: Let AI Assistants Generate Word Documents for You
人工智能·word