如何在VBA中为Visio形状数据的Variable List类型赋值

背景 #

我在Visio中创建了一个基础矩形形状，已通过右键→数据→定义形状数据添加了形状数据。其中「Parents」和「Children」两项的类型为Variable List，需求是通过宏控制，让「Parents」列出所有下游形状名称，「Children」列出所有上游形状名称（注：逻辑看似颠倒，但对应实际场景需求）。

VBA中已定义形状对象：

Dim myShape As Shape

同时存在常规类型的形状数据（如字符串类型的「Description」），可通过以下方式赋值：

myShape.Cells("Prop.Description.Value").Formula = value ' value为目标字符串或公式字符串

通过myShape.Cells("Prop.Description.Type").Formula返回值为4，对应常量visPropTypeListVar，确认该类型为Variable List。

问题 #

找不到Variable List类型形状数据的操作示例，需解决以下问题：

1. 如何为Prop.Parents分配/添加列表值？即Variable List类型的数据格式化规则是什么？
2. 在resetProperties函数中，如何将「Parents」和「Children」设置为空列表？

解决方案 #

1. 为Variable List类型分配列表值 #

Visio的Variable List类型形状数据，其值本质是分号分隔的字符串，赋值时需要将该字符串用双引号包裹（符合Visio公式的语法要求）。

静态赋值示例

如果要为Prop.Parents添加「ShapeA」「ShapeB」两个列表项：

' 直接赋值分号分隔的字符串，外层用双引号包裹（VBA中需用两个双引号转义）
myShape.Cells("Prop.Parents.Value").Formula = """ShapeA;ShapeB"""

动态赋值示例（收集下游形状名称）

如果需要自动收集下游形状名称并赋值：

Dim downstreamShapes As Shapes
Dim targetShape As Shape
Dim listValues As String

' 假设已获取当前形状的下游形状集合downstreamShapes
For Each targetShape In downstreamShapes
    ' 拼接形状名称，用分号分隔
    listValues = listValues & targetShape.Name & ";"
Next

' 移除末尾多余的分号（如果有）
If Len(listValues) > 0 Then
    listValues = Left(listValues, Len(listValues) - 1)
End If

' 赋值到Variable List
myShape.Cells("Prop.Parents.Value").Formula = """" & listValues & """"

2. 将Variable List设置为空列表 #

要清空Variable List，只需将其值设置为空字符串（带双引号），示例代码：

' 方式1：用双引号转义实现空字符串
myShape.Cells("Prop.Parents.Value").Formula = """"""
myShape.Cells("Prop.Children.Value").Formula = """"""

' 方式2：用Chr(34)（双引号的ASCII码）拼接，可读性更强
myShape.Cells("Prop.Parents.Value").Formula = Chr(34) & Chr(34)
myShape.Cells("Prop.Children.Value").Formula = Chr(34) & Chr(34)

如果要整合到resetProperties函数中：

Sub resetProperties(targetShape As Shape)
    ' 重置其他常规形状数据
    targetShape.Cells("Prop.Description.Value").Formula = """默认描述"""
    
    ' 清空Variable List类型的Parents和Children
    targetShape.Cells("Prop.Parents.Value").Formula = Chr(34) & Chr(34)
    targetShape.Cells("Prop.Children.Value").Formula = Chr(34) & Chr(34)
End Sub

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