word批量导出visio图

具体步骤

修改word格式

将word文档修改为docm格式

打开VBA窗口

打开开发工具VisualBasic项,如果没有右键在自定义功能区添加

插入代码

插入 -> 模块,代码如下:

vba 复制代码
Sub ExportAllVisioDiagrams()
    Dim shp As InlineShape
    Dim i As Integer
    Dim savePath As String
    Dim docName As String
    Dim visioApp As Object
    Dim visioDoc As Object
    Dim startTime As Double
    
    ' 设置保存路径(修改为您想要的路径)
    savePath = "C:\Users\"
    
    ' 创建文件夹(如果不存在)
    If Dir(savePath, vbDirectory) = "" Then MkDir savePath
    
    ' 获取文档名称(不含扩展名)
    If ActiveDocument.Name Like "*.*" Then
        docName = Left(ActiveDocument.Name, InStrRev(ActiveDocument.Name, ".") - 1)
    Else
        docName = ActiveDocument.Name
    End If
    
    ' 创建Visio应用实例
    Set visioApp = CreateObject("Visio.Application")
    visioApp.Visible = True ' 设置为可见以便调试
    
    i = 1
    For Each shp In ActiveDocument.InlineShapes
        If shp.Type = wdInlineShapeEmbeddedOLEObject Then
            If InStr(1, shp.OLEFormat.ProgID, "Visio", vbTextCompare) > 0 Then
                On Error Resume Next
                
                ' 激活并选择Visio对象内容
                shp.OLEFormat.Activate
                shp.OLEFormat.Object.Application.ActiveWindow.SelectAll
                shp.OLEFormat.Object.Application.ActiveWindow.Selection.Copy
                
                ' 创建新Visio文档
                Set visioDoc = visioApp.Documents.Add("")
                
                ' 添加延迟确保复制完成
                startTime = Timer
                Do While Timer < startTime + 1
                    DoEvents
                Loop
                
                ' 粘贴内容
                visioApp.ActiveWindow.Page.Paste
                
                ' 保存文件
                visioDoc.SaveAs savePath & docName & "_Diagram" & i & ".vsdx"
                If Err.Number <> 0 Then
                    visioDoc.SaveAs savePath & docName & "_Diagram" & i & ".vsd"
                End If
                
                visioDoc.Close
                Set visioDoc = Nothing
                
                i = i + 1
                
                ' 每处理3个图表后增加延迟
                If i Mod 3 = 0 Then
                    startTime = Timer
                    Do While Timer < startTime + 2 ' 延迟2秒
                        DoEvents
                    Loop
                End If
                
                On Error GoTo 0
            End If
        End If
    Next shp
    
    ' 关闭Visio
    visioApp.Quit
    Set visioApp = Nothing
    
    MsgBox "已导出 " & (i - 1) & " 个Visio图表到 " & savePath
End Sub

运行代码

点击运行 -> 运行子过程即可

相关推荐
武子康32 分钟前
Java-51 深入浅出 Tomcat 手写 Tomcat 类加载机制 双亲委派机制 生命周期 插件化
java·开发语言·spring boot·后端·spring·tomcat·springcloud
爬虫程序猿36 分钟前
如何利用 Java 爬虫获得微店商品详情:实战指南
java·开发语言·爬虫
benben04443 分钟前
Unity3D仿星露谷物语开发69之动作声音
游戏·ui·unity·c#·游戏引擎
JovaZou1 小时前
[Python学习日记-92] 并发编程之多线程 —— 守护线程
开发语言·python·学习
火鸟21 小时前
Rust 通用代码生成器:莲花,红莲尝鲜版三十六,蛋糕商城哑数据模式
开发语言·rust·通用代码生成器·蛋糕商城·莲花·红莲·哑数据模式
唐青枫1 小时前
C#.NET in、out、ref详解
c#·.net
虾球xz1 小时前
CppCon 2017 学习:Meta
开发语言·c++·学习
99乘法口诀万物皆可变3 小时前
C#设计模式-Builder-生成器-对象创建型模式
开发语言·c#
钢铁男儿3 小时前
C# 数组(数组是对象和一维数组和矩形数组)
算法·c#
cfqq19895 小时前
class对象【C#】2025复习
开发语言·c#