Word VBA：批量导出Visio对象为图片

最新推荐文章于 2024-01-26 08:53:26 发布

VBA-守候

最新推荐文章于 2024-01-26 08:53:26 发布

阅读量854

点赞数

分类专栏： VBA办公自动化文章标签： vba 自动化 msword 编程语言流程图

本文链接：https://blog.csdn.net/qq_64613735/article/details/125822679

版权

VBA办公自动化专栏收录该内容

21 篇文章 13 订阅

订阅专栏

一、思路

因为Word中的Visio对象也是Word中的域，所以在遍历的时候既可以遍历文档中的域（fields），也可以遍历文档中的图片（inlineshapes）。本文是用遍历域的方法：

1.遍历文档中的域fd

2.判断每一个域fd

如果域代码中包含【EMBED Visio.Drawing.】，则说明是Visio对象，可以进行后续处理。

3.二进制存储

对于这个域的图片的二进制内容【fd.InlineShape.Range.EnhMetaFileBits】，使用【ADODB.STREAM】对象进行如下操作：

（1）以二进制方式打开【ADODB.STREAM】对象

（2）将这个域的图片的二进制内容【fd.InlineShape.Range.EnhMetaFileBits】写入（write)【ADODB.STREAM】对象

（3）将写入的内容存储为文件【savetofile】

（4）关闭【ADODB.STREAM】对象

二、示例代码

1.代码

Sub 批量导出Visio图()
    Dim aDoc As Document
    Dim fd As Field
    Dim aDos As Object
    Dim k As Long
    Dim fDia As FileDialog
    Dim saveFolder As String
    'Dim fileType As String
    Dim fileName As String
    Dim t0 As Single
    
    t0 = Timer
    Set aDoc = ActiveDocument
    Set aDos = CreateObject("ADODB.STREAM")
    Set fDia = Application.FileDialog(msoFileDialogFolderPicker)
    
    With fDia
        .Title = "选择图片存储位置（文件夹）："
        If .Show Then
            saveFolder = .SelectedItems(1)
            'fileType = Trim(InputBox("请输入支持的图片格式后缀（如png、jpeg、jpg、gif等）：", "图片格式", "jpg"))
            For Each fd In aDoc.Fields
                If fd.Code Like "*EMBED Visio.Drawing.*" Then
                    k = k + 1
                    fileName = saveFolder & "\" & k & ".emf"
                    With aDos
                        .Open
                        .Type = 1
                        .write fd.InlineShape.Range.EnhMetaFileBits
                        .savetofile fileName
                        .Close
                    End With
                    Debug.Print Format(k, "第0个Visio图片存储完成！")
                End If
            Next
        End If
    End With
    
    Set aDoc = Nothing
    Set aDos = Nothing
    Set fDia = Nothing
    
    MsgBox Format(k, "完成 共处理了0个Visio图片  用时：") & Timer - t0 & "秒"
End Sub