I am trying to write a code in Visio VBA to 1. loop through shapes on a page, 2. for each shape find what shapes are connected to it, 3. gather the connected shapes in a line to take a nice photo, and 4. place them back where they were.
My issue is, once I gather the shapes in a line, sometimes, the connector doesn't move with it (as though detaching itself once the shape is moved) and I can't figure out the reason why.
I have checked all of my connector glue settings. They are all fine:
glue settings
The connection types between shapes are all "static", meaning the point at which the connector is glued to a shape does not change when the shape is moved. But this doesn't seem to be an issue since the detachments happen for some shapes and not others.
Here's a snippet of my code:
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
question from:
https://stackoverflow.com/questions/65838271/visio-vba-customized-code-to-align-shapes-does-not-update-connectors-before-ex 与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…