Visio VBA - 用于对齐形状的自定义代码在导出为照片之前不会更新连接器

问题描述

我正在尝试在 Visio VBA 中编写代码以 1. 循环浏览页面上的形状，2. 为每个形状找到与其连接的形状，3. 将连接的形状聚集在一条线上以拍一张漂亮的照片,和 4. 将它们放回原处。

我的问题是，一旦我将形状聚集成一条线，有时，连接器不会随之移动（好像一旦形状移动就会自行分离），我无法弄清楚原因。

>

我已经检查了所有连接器胶水设置。他们都很好： glue settings

形状之间的连接类型都是“静态的”，这意味着当形状移动时，连接器粘在形状上的点不会改变。但这似乎不是问题，因为分离发生在某些形状而不是其他形状上。

这是我的代码片段：

        For Each oShape In myPage.Shapes
            vsoSelection.deselectAll
            sFile = ThisDocument.Path + oShape.Data3 + ".png"
            conShapeIDs = oShape.ConnectedShapes(visConnectedShapesOutgoingNodes,"")
            'Count connected shapes
            'Create array of connected shapes

            '|||Align Connected Shapes|||>>>
            For x = 0 To CountConShapes - 1
                If x = 0 Then
                    Set Shp1 = myPage.Shapes.Item(Array(x,1))
                    vsoSelection.Select Shp1,visSelect
                    'If there is only one shape attached,just centre it
                    If CountConShapes = 1 Then
                        If Shp1.Cells("pinx") <> oShape.Cells("pinx") Then
                            Shp1.Cells("pinx") = oShape.Cells("pinx")
                            Moved = Moved + 1
                        End If
                    End If
                    'Place the first shape in the right place,IF there are more than one shapes
                    If CountConShapes Mod 2 = 0 Then
                        'code for even numbered shapes:
                        distFromCentre = 0.2 * ((CountConShapes - 1) / 2) + (Shp1.Cells("Width") / 2)
                        For w = 1 To (CountConShapes / 2) - 1
                            distFromCentre = distFromCentre + myPage.Shapes.Item(Array(w,1)).Cells("Width")
                        Next
                        Shp1.Cells("pinx") = oShape.Cells("pinx") - distFromCentre
                        Moved = Moved + 1
                    End If
                    If CountConShapes > 1 And CountConShapes Mod 2 = 1 Then
                        'code for odd numbered shapes
                    End If
                End If
                If x > 0 Then
                    Set Shp2 = myPage.Shapes.Item(Array(x,1))
                    vsoSelection.Select Shp2,visSelect
                    If Shp2.Cells("pinx") - Shp1.Cells("pinx") <> x * (Shp2.Cells("Width") + 0.2) Then
                        'Align Right - x-coordinate
                        Shp2.Cells("pinx") = Shp1.Cells("pinx") + x * (Shp2.Cells("Width") + 0.2)
                        Moved = Moved + 1
                    End If
                    If Shp2.Cells("piny") <> Shp1.Cells("piny") Then
                        'Align Centre - y-coordinate
                        Shp2.Cells("piny") = Shp1.Cells("piny")
                        Moved = Moved + 1
                    End If
                End If
                vsoSelection.deselectAll
            Next
        
            '|||END of Align Connected Shapes|||

            '|||SELECT ALL SHAPES AND CONNECTIONS AND EXPORT|||>>>
            For i = 0 To UBound(conShapeIDs)
                vsoSelection.Select myPage.Shapes.ItemFromID(conShapeIDs(i)),visSelect
            Next
            conConnectorIDs = oShape.gluedShapes(visgluedShapesOutgoing1D,"")
            For j = 0 To UBound(conConnectorIDs)
                vsoSelection.Select myPage.Shapes.ItemFromID(conConnectorIDs(j)),visSelect
            Next
            vsoSelection.Select oShape,visSelect
            vsoSelection.Export (sFile)
        
            'Undoing shape movements:
            If MovedSol > 0 Then
                For i = 1 To MovedSol
                    Visio.Application.Undo
                Next
            End If
        Next

解决方法

暂无找到可以解决该程序问题的有效方法，小编努力寻找整理中！

如果你已经找到好的解决方法，欢迎将解决方案带上本链接一起发送给小编。

小编邮箱:dio#foxmail.com (将#修改为@）