如何通过VBA按精确RGB颜色选择Visio图形？

尝试过程与问题 #

• 初始尝试代码：

If Vshp.CellsU("FillForegnd").FormulaU = "RGB(128,128,128)" Then
 sel.Select Vshp, visSelect
End If

问题：代码运行后无任何反应。

• 更新1尝试代码：

If Vshp.Shapes(4).CellsU("FillForegnd").FormulaU = "RGB(128,128,128)" 
 Then
 sel.Select Vshp, visSelect
End If

问题：触发“Invalid Sheet identifier”错误，指向判断条件行。

• 更新2发现：
  子图形.Shapes(4)为文本对象；需要读取绘图资源管理器窗口内容，或通过名称选择图形（但图层内存在多个同名图形，无法精准定位到Cabinet(Fibre Schematic).2125）。

• 更新3尝试代码：

For Each subshp In vShp.Shapes
 If subshp.CellsU("FillForeground").FormulaU = "RGB(128,128,128)" Then
   ActiveWindow.Select subshp, visSubSelect
   End If
 Next subshp

问题：触发“Unexpected end of file”错误，指向判断条件行。

正确实现方案 #

核心修复点

1. 单元格名称拼写错误：Visio中填充前景色的标准单元格是FillForegnd，而非FillForeground。
2. 避免索引访问子图形：直接用索引（如.Shapes(4)）易出错，改为遍历所有子图形更可靠。
3. 用数值对比颜色：Visio中RGB颜色可能以RGB(r,g,b)公式或直接数值存储，通过ResultIU获取颜色数值对比，比匹配公式更精准。

完整可运行代码

Sub SelectShapesByRGB()
    Dim targetRGB As Long
    Dim vPage As Visio.Page
    Dim vShp As Visio.Shape
    Dim subShp As Visio.Shape
    
    ' 设置目标RGB颜色（128,128,128）
    targetRGB = RGB(128, 128, 128)
    
    ' 获取当前活动页面
    Set vPage = ActivePage
    
    ' 清除现有选择，避免干扰
    ActiveWindow.DeselectAll
    
    ' 遍历页面所有图形
    For Each vShp In vPage.Shapes
        ' 处理组图形，遍历内部子图形
        If vShp.Type = visTypeGroup Then
            For Each subShp In vShp.Shapes
                CheckAndSelectShape subShp, targetRGB
            Next subShp
        Else
            ' 处理单个图形
            CheckAndSelectShape vShp, targetRGB
        End If
    Next vShp
End Sub

' 辅助函数：检查图形颜色并选择
Sub CheckAndSelectShape(shp As Visio.Shape, targetColor As Long)
    Dim cell As Visio.Cell
    Dim currentColor As Long
    
    ' 容错处理：避免无填充属性的图形报错
    On Error Resume Next
    Set cell = shp.CellsU("FillForegnd")
    On Error GoTo 0
    
    If Not cell Is Nothing Then
        ' 获取颜色的数值形式，避免公式写法差异导致的匹配失败
        currentColor = cell.ResultIU
        If currentColor = targetColor Then
            ActiveWindow.Select shp, visSelect
        End If
    End If
End Sub

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