在 Visio VBA 中，如何读取和设置连接器的权重

Question

我尝试保存一个宏，在其中设置连接器的权重，并得到如下表达式

Application.ActiveWindow.Page.Shapes.ItemFromID(17).CellsSRC(visSectionObject, visRowLine, visLineWeight).FormulaU = "6 pt"

我写了这个：

    For Each conn In Application.ActiveWindow.Page.Connects
        conn.CellsSRC(visSectionObject, visRowLine, visLineWeight).FormulaU = "6 pt"
    Next

我收到错误 438“对象不支持此属性或方法”。

在微软的文档中，我找不到关于如何读取和设置连接器重量的提及。例如，Connect 对象的文档页面https://learn.microsoft.com/en-us/office/vba/api/visio.connect 不包含对任何样式属性的引用。

编辑********************************************

读完建议后，我仍然很困惑。

1. 我按照建议查找了使用 VBA 在 Visio 中将连接器的宽度更改为特定对象。我尝试了ActivePage.shapes(connections(1)).Cells("LineWeight").Formula = "10 pt"

   （在答案中，它是连接（i）），我在

   sub or function not defined

   部分收到错误

   connections(1)

   。

2. 我尝试使用FromSheet。我做到了

For Each connnn In Application.ActiveWindow.Page.Connects 
         shp = connnn.FromSheet 
         Debug.Print ("shp.Type=" + CStr(shp.Type)) 
        Debug.Print (shp.Type = visObjTypeConnect)
        shp.CellsSRC(visSectionObject, visRowLine, visLineWeight).FormulaU = "10 pt"
Next

我收到“需要对象”错误。

3. 我尝试将所有形状的线宽设置为“10 pt”。这有效！

4. 所以我尝试过滤连接器，如下：

    Set allShapes = Application.ActiveWindow.Page.shapes
    For Each shp In allShapes
        Debug.Print ("shp.Type=" + CStr(shp.Type))
        Debug.Print (shp.Type = visObjTypeConnect)
        If shp.Type = visObjTypeConnect Then
            shp.CellsSRC(visSectionObject, visRowLine, visLineWeight).FormulaU = "10 pt"
        End If
    Next

没有变化，请参阅下面的输出。根据

https://learn.microsoft.com/en-us/office/vba/api/visio.visobjecttypes，3 表示 visObjTypeApp，4 表示 visObjTypeCell，2 未列出（visObjTypeConnect 为 8）：

shp.Type=2
错误
shp.Type=3
错误
shp.Type=3
错误
shp.Type=4
错误
（更多相同）

Answer 1

如果您的意思是

connector

 Visio 的对象

动态连接器，您可以使用CreateSelection 方法…

通过主形状迭代连接器（选择类型

visSelTypeByMaster）

Dim sl As Selection, shp As Shape, mast As Master
Set mast = ActiveDocument.Masters("Dynamic connector")
Set sl = ActivePage.CreateSelection(visSelTypeByMaster, visSelModeSkipSuper, mast)
For i = 1 To sl.Count
    Set shp = sl.Item(i)
    shp.CellsSRC(visSectionObject, visRowLine, visLineWeight).FormulaU = "6 pt"
Next

或通过层迭代连接器（选择类型

visSelTypeByLayer）

Dim sl As Selection, shp As Shape
Set sl = ActivePage.CreateSelection(visSelTypeByLayer, , "Connector")
For i = 1 To sl.Count
    Set shp = sl.Item(i)
    shp.CellsSRC(visSectionObject, visRowLine, visLineWeight).FormulaU = "6 pt"
Next

PS

我收到“需要对象”错误。

你必须使用语法

Set shp = connnn.FromSheet

Answer 2

*** 这并不适用于所有情况，需要进一步调查

使用代理的解决方案，基于选择对象，我无法找到访问组内连接器的方法。 我发现一个形状参数似乎提供了所需的信息：

shape.fillStyle

。对于连接器，其值为 

"Connector"

。文档中没有明确说明这一点，因此欢迎您对此方法的局限性提出意见。

不管怎样，我写了一组使用这个参数的函数。

' Sets all shapes to line colors to dark blue, then sets all connectors to dark red
Sub test_all_shapes_and_connectors()
Dim set1, set2 As Collection
Set set1 = get_all_shapes
Set set2 = get_all_connectors
For Each shp In set1
    set_line_color shp, "0,0,127"
Next
For Each shp In set2
    set_line_color shp, "127,0,0"
Next
End Sub

Function get_all_shapes()
    Set get_all_shapes = get_multi_shapes(Application.ActiveWindow.Page.shapes)
End Function

Function get_all_connectors()
    Set get_all_connectors = get_multi_shapes(Application.ActiveWindow.Page.shapes, "Connector")
End Function

' gets all the shapes in the page, including inside groups.
' fillStyleCrit is optional, if omitted the function gets all shapes
' fillStyleCrit = "Connector" selects only connectors ("lines")
Function get_multi_shapes(oldSet, Optional fillStyleCrit As String = "") As Collection
Dim newSet As New Collection
For Each stuffToAdd In oldSet
    If stuffToAdd.Type <> visTypeGroup Then
        If fillStyleCrit = "" Or fillStyleCrit = stuffToAdd.FillStyle Then
            newSet.Add stuffToAdd
            Set get_multi_shapes = newSet
        End If
    ElseIf stuffToAdd.Type = visTypeGroup Then
        For Each subshp In stuffToAdd.shapes
            newSet.Add subshp
        Next
        Set get_multi_shapes = get_multi_shapes(newSet)
    End If
Next
End Function


Function set_line_color(shp, rgb1)
On Error GoTo exit_set_line_color
    Dim s, newColor As String
    s = simple_RGB(rgb1)
    newColor = "THEMEGUARD(RGB(" + s + "))"
    Debug.Print ("setting line color to " + newColor)
    shp.CellsSRC(visSectionObject, visRowLine, visLineColor).FormulaU = newColor
exit_set_line_color:
End Function