Visio中批量调整线性形状文本位置的VBA实现问题

核心代码（按形状类型精准筛选） #

Sub BatchCenterLineShapeText()
    Dim vsoPage As Visio.Page
    Dim vsoShape As Visio.Shape
    
    ' 获取当前活动页面，避免未限定引用错误
    Set vsoPage = Visio.ActivePage
    If vsoPage Is Nothing Then
        MsgBox "请先打开一个Visio页面！", vbExclamation
        Exit Sub
    End If
    
    ' 遍历页面所有形状
    For Each vsoShape In vsoPage.Shapes
        ' 判断是否为线性形状（Visio内置类型：visTypeLine=2）
        If vsoShape.Type = visTypeLine Then
            ' 设置文本水平居中
            vsoShape.CellsSRC(visSectionObject, visRowText, visTxtHorzAlign).FormulaU = "visHorzAlignCenter"
            ' 可选：设置文本垂直居中（按需启用）
            ' vsoShape.CellsSRC(visSectionObject, visRowText, visTxtVertAlign).FormulaU = "visVertAlignMiddle"
        End If
    Next vsoShape
    
    MsgBox "所有线性形状文本已完成居中调整！", vbInformation
End Sub

按形状名称匹配的变种（按需选择） #

如果需要按特定名称筛选（比如名称包含"Line"或精确匹配指定名称），替换上述代码中的判断逻辑即可：

模糊匹配（名称包含指定关键词） #

' 替换原If判断为：
If InStr(1, vsoShape.Name, "Line", vbTextCompare) > 0 Then
    ' 执行居中操作
End If

精确匹配多个指定名称 #

' 替换原If判断为：
Select Case vsoShape.Name
    Case "Line_01", "CustomLine", "FlowLine"
        ' 执行居中操作
End Select

运行步骤 #

1. 打开目标Visio文件，切换到需要调整的页面
2. 按Alt + F11打开VBA编辑器
3. 在左侧工程窗口右键点击当前文档，选择「插入」→「模块」
4. 将代码粘贴到模块窗口
5. 按F5运行宏，或回到Visio界面通过「开发工具」→「宏」选择执行

常见问题修复 #

• 「Invalid or unqualified reference」错误：原代码未明确限定Visio对象（如直接调用Shapes而非Page.Shapes），上述代码通过Visio.ActivePage和Visio.Shape明确对象层级，可解决该问题。
• 按名称匹配仅识别第一个形状：原代码可能使用了Shapes("ShapeName")的单对象调用，这种方式仅返回第一个匹配项；遍历所有形状并逐个判断的逻辑可覆盖所有符合条件的形状。

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