Visio VBA问题：修改图形字体大小无响应求助

我在尝试用VBA修改Visio中指定图形的字体大小时，完全没有任何反应。我的代码如下：

For Each Vshp In VPage.Shapes
    If Vshp.Name Like "*UG*" Then
        Debug.Print Vshp.ID & " - " & Vshp.Master.Name
        Vshp.CellsSRC(visSectionCharacter, 0, visCharacterSize).FormulaU = "12 pt"
    End If
Next

尝试过两种常见修改字体大小的VBA方法，但均无效。

可能的原因 #

• 主形状/样式锁定格式：目标形状基于的主形状（Master）可能设置了不可覆盖的文本格式，直接修改形状的CharacterSize单元格会被主形状的样式优先级覆盖。
• 仅修改了单段文本：visSectionCharacter的索引0对应形状的第一段文本，若形状内有多段不同格式的文本，只修改索引0无法影响全部内容。
• 目标是组合形状：如果Vshp是组合形状，直接修改组合的字体设置不会作用到内部子形状，必须遍历子形状单独修改。
• 单元格被保护：部分形状的CharacterSize单元格可能开启了公式保护，无法直接赋值修改。

解决办法 #

1. 强制覆盖样式，设置全局字体大小
   直接通过Text.Characters属性设置整个文本的字体大小，或者先清除样式再修改单元格：

   For Each Vshp In VPage.Shapes
       If Vshp.Name Like "*UG*" Then
           ' 方法1：一键设置所有文本的字体大小
           Vshp.Text.Characters.FontSize = 12
           ' 方法2：清除继承样式后修改单元格
           Vshp.TextStyle = ""
           Vshp.CellsSRC(visSectionCharacter, visRowCharacter, visCharacterSize).FormulaU = "12 pt"
       End If
   Next
   

2. 递归遍历组合内的子形状
   针对组合形状，需要逐层遍历内部子形状进行修改：

   Sub SetFontSizeInGroup(ByVal shp As Visio.Shape, ByVal size As Double)
       If shp.Type = visTypeGroup Then
           Dim subShp As Visio.Shape
           For Each subShp In shp.Shapes
               SetFontSizeInGroup subShp, size
           Next
       Else
           If shp.Name Like "*UG*" Then
               shp.Text.Characters.FontSize = size
           End If
       End If
   End Sub
   
   ' 调用示例
   For Each Vshp In VPage.Shapes
       SetFontSizeInGroup Vshp, 12
   Next
   

3. 解除单元格保护后修改
   先检查并解除单元格锁定，再修改公式：

   For Each Vshp In VPage.Shapes
       If Vshp.Name Like "*UG*" Then
           With Vshp.CellsSRC(visSectionCharacter, 0, visCharacterSize)
               If .CellExists(visExistsAnywhere) Then
                   If .IsLocked Then .IsLocked = False
                   .FormulaU = "12 pt"
               End If
           End With
       End If
   Next
   

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