Visio Standard下如何通过VBA导入Excel数据自动生成ERD

本方案完全不依赖Visio Professional专属的数据导入、自动生成向导功能，仅通过VBA即可实现，适配所有Standard版本。

前置准备 #

• 将团队通用的ERD标准形状模具（.vssx格式）存到本地固定路径，推荐存到Visio默认的「我的形状」目录，避免宏运行时无法加载形状
• Excel端按固定字段整理结构化数据源，列顺序固定为：实体唯一ID、实体名称、实体类型、匹配模具形状名、上级实体ID、X坐标、Y坐标，其中实体ID不可重复，上级实体ID为空的判定为顶层实体
• 提前开启Visio宏权限：依次打开「文件-选项-信任中心-信任中心设置-宏设置」，临时启用所有宏，同时勾选「信任对VBA工程对象模型的访问」，使用完成后可切回原安全设置

核心VBA实现 #

宏部署步骤 #

1. 打开Visio新建空白绘图，按Alt+F11调出VBA编辑器，插入标准模块
2. 将以下可直接运行的代码粘贴到模块中，替换代码里的模具路径为你本地的实际存储路径

Sub 批量生成ERD()
    Dim vsPage As Visio.Page
    Dim vsStencil As Visio.Document
    Dim vsShape As Visio.Shape, connShape As Visio.Shape
    Dim xlApp As Object, xlWb As Object, xlWs As Object
    Dim dictEntity As Object
    Dim lastRow As Long, i As Long, filePth As Variant
    Dim entId, entName, shapeName, parentId, posX, posY
    
    ' 初始化当前绘图页，清空原有内容
    Set vsPage = ActiveDocument.Pages(1)
    vsPage.Shapes.SelectAll
    Selection.Delete
    
    ' 加载本地标准ERD模具，替换为你的实际模具路径
    Set vsStencil = Application.Documents.OpenEx("C:\Users\当前用户名\Documents\我的形状\ERD通用标准模具.vssx", visOpenDocked)
    
    ' 弹窗选择整理好的Excel数据源
    Set xlApp = CreateObject("Excel.Application")
    xlApp.Visible = False
    filePth = Application.GetOpenFilename("Excel文件(*.xlsx),*.xlsx", , "选择ERD数据源文件")
    If filePth = False Then
        xlApp.Quit
        Exit Sub
    End If
    Set xlWb = xlApp.Workbooks.Open(filePth)
    Set xlWs = xlWb.Sheets(1) ' 若数据源不在第一个sheet，可修改为对应表名
    lastRow = xlWs.Cells(xlWs.Rows.Count, 1).End(-4162).Row
    
    Set dictEntity = CreateObject("Scripting.Dictionary")
    
    ' 第一轮遍历：批量生成所有实体形状
    For i = 2 To lastRow ' 第一行为表头，从第二行读取数据
        entId = xlWs.Cells(i, 1).Value
        entName = xlWs.Cells(i, 2).Value
        shapeName = xlWs.Cells(i, 4).Value
        posX = xlWs.Cells(i, 6).Value
        posY = xlWs.Cells(i, 7).Value
        
        ' 从模具拖入对应形状到指定坐标
        Set vsShape = vsPage.Drop(vsStencil.Masters(shapeName), posX, posY)
        vsShape.Text = entName
        dictEntity.Add entId, vsShape
    Next
    
    ' 第二轮遍历：批量生成实体间关系连线
    For i = 2 To lastRow
        entId = xlWs.Cells(i, 1).Value
        parentId = xlWs.Cells(i, 5).Value
        If parentId <> "" And dictEntity.Exists(parentId) Then
            ' 使用动态连接线，可替换为模具内自定义的关系线形状
            Set connShape = vsPage.Drop(Application.ConnectorToolDataObject, 0, 0)
            connShape.CellsU("BeginX").GlueTo dictEntity(parentId).CellsU("PinX")
            connShape.CellsU("EndX").GlueTo dictEntity(entId).CellsU("PinX")
            ' 若需要标注关系基数（1:1、1:N等），可在Excel加对应列，读取值赋值给connShape.Text即可
        End If
    Next
    
    ' 自动布局排版，避免形状重叠
    vsPage.Layout
    
    ' 清理Excel后台进程
    xlWb.Close SaveChanges:=False
    xlApp.Quit
    Set xlWs = Nothing: Set xlWb = Nothing: Set xlApp = Nothing
    MsgBox "ERD生成完成"
End Sub

3. （可选）如果不想手动在Excel里填写每个实体的XY坐标，可以在第一轮遍历前加一段自动计算坐标的逻辑：顶层实体统一放在绘图页顶部横向均匀排布，下级实体按层级在对应上级下方固定垂直间距排列，水平方向按同层级实体数量均分位置，完全省去手动填坐标的步骤。

模板封装 #

将写好宏的Visio文件保存为.vstm格式（启用宏的Visio模板），后续需要绘制新ERD时，直接双击打开模板，选择提前整理好的Excel数据源即可一键生成，不需要重复部署代码。

常见问题处理 #

• 运行报错提示“不存在该主控形状”：检查Excel中填写的形状名称和模具内形状的实际命名完全一致，注意多余空格、特殊字符的匹配
• 连线粘连、形状重叠：运行代码时已经内置了自动布局接口，若排版不符合预期，可手动微调后固定形状位置
• 宏无法运行：确认宏权限已正确开启，模板文件不要存放在系统受限目录下

内容的提问来源于stack exchange，提问作者Tax