我帮你梳理了代码里的几个关键问题，这些问题导致代码要么提前终止，要么逻辑混乱，所以看起来没报错但没实际生效：

核心问题分析 #

• 循环提前终止：你在第一个If mst.Name = "Dynamic connector"分支里写了Exit For，这会让循环只遍历页面上的第一个形状就直接退出，后面的形状根本不会被处理——这是代码没生效的最主要原因。
• If语句结构错误：第二个判断If mst.Name = "Process"没有对应的End If，而且和第一个If是并列关系，应该用ElseIf或者单独闭合，否则逻辑会混乱，甚至可能导致部分代码永远不会执行。
• 未初始化Visio应用对象：你声明了VisioApp但没有给它赋值，直接调用VisioApp.Visible = True会触发错误，只是因为循环提前终止，代码没走到这一步才没报错。
• 文本属性设置的潜在问题：设置字号时没有判断形状是否有文本，而且没有应用你获取的Verdana字体ID，达不到预期的字体设置效果。

修正后的代码 #

Sub ShapeControl()
    Dim shp As Visio.Shape
    Dim mst As Visio.Master
    Dim Verdana_ID As Integer
    Dim ActiveDoc As Visio.Document
    Dim ActivePage As Visio.Page
    Dim VisioApp As Visio.Application
    
    ' 尝试获取目标文档，若未打开则启动Visio并打开
    On Error Resume Next
    Set ActiveDoc = GetObject("C:\Users\z028317\Desktop\Architecutre Flowchart.vsdm")
    If Err.Number <> 0 Then
        Set VisioApp = New Visio.Application
        Set ActiveDoc = VisioApp.Documents.Open("C:\Users\z028317\Desktop\Architecutre Flowchart.vsdm")
    End If
    On Error GoTo 0
    
    ' 确保成功获取文档
    If ActiveDoc Is Nothing Then
        MsgBox "无法打开目标Visio文档！"
        Exit Sub
    End If
    
    ' 确保Verdana字体存在
    On Error Resume Next
    Verdana_ID = ActiveDoc.Fonts.Item("Verdana").ID
    If Err.Number <> 0 Then
        MsgBox "未找到Verdana字体，请确保已安装！"
        Exit Sub
    End If
    On Error GoTo 0
    
    Set ActivePage = ActiveDoc.Pages("Page-1")
    Set VisioApp = ActiveDoc.Application ' 初始化Visio应用对象
    VisioApp.Visible = True ' 提前让Visio可见，方便查看效果
    
    ' 遍历页面中的所有形状
    For Each shp In ActivePage.Shapes
        Set mst = shp.Master
        ' 仅处理带有母版的形状
        If Not (mst Is Nothing) Then
            ' 连接线属性设置
            If mst.Name = "Dynamic connector" Then
                shp.Cells("LineColor").FormulaU = "RGB(255,192,0)"
                shp.Cells("LineWeight").FormulaU = "1 pt"
            ' 流程框属性设置
            ElseIf mst.Name = "Process" Then
                shp.Cells("Width").FormulaU = "1 in" ' 明确单位为英寸
                shp.Cells("Height").FormulaU = "1 in"
                ' 仅当形状有文本时设置字体和字号
                If shp.Text <> "" Then
                    With shp.Characters
                        .CharProps visCharacterFont, Verdana_ID
                        .CharProps visCharacterSize, 12
                    End With
                End If
            End If
        End If
    Next shp ' 遍历所有形状，不再提前退出
End Sub

关键修改说明 #

1. 移除错误的Exit For：让循环可以遍历页面上的所有形状，而不是第一个就终止。
2. 修正If语句结构：用ElseIf处理并列的母版判断，确保每个分支都有对应的闭合语句，逻辑更清晰。
3. 初始化VisioApp对象：通过Set VisioApp = ActiveDoc.Application绑定到当前文档的应用实例，同时提前设置Visible = True，方便实时查看修改效果。
4. 增加错误处理：处理文档打开失败、字体不存在的情况，避免静默出错，同时给出明确提示。
5. 明确单位和规范公式写法：使用FormulaU（通用公式）替代Formula，同时明确标注单位（如1 in），避免歧义。
6. 完善文本属性设置：判断形状是否有文本后再设置字体和字号，同时应用你获取的Verdana字体ID，实现完整的字体设置需求。

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