如何解决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 举报,一经查实,本站将立刻删除。