CODEWITHSUNDEEP
vbavisio
Geographos
Geographos

Reputation: 1456

Change the text shape position in MS Visio

I have the schematic, in which the Visio text (comprising of the linear shape) is placed wrong. Instead of in the middle it falls far to the right.

I would like to have all of them centered instead.

Because I am completely new to VBA Visio I've recorded a macro in order to get around the basic code properties of these circumstances.

My VBA code states, that each shape has its own ID, which is hard to distinguish it from other - point shapes. Because I've managed pretty much with defining the range of shape IDs needed for my goal, by using this thread:

https://learn.microsoft.com/en-us/office/client-developer/visio/change-the-name-and-view-the-id-of-a-shape

I decided to use the code just for these shapes, which ID is higher than the particular value. Unfortunately the following code:

Sub SLDalter()
Dim DiagramServices As Integer
DiagramServices = ActiveDocument.DiagramServicesEnabled
ActiveDocument.DiagramServicesEnabled = visServiceVersion140 + visServiceVersion150

Dim UndoScope As Long
UndoScope = Application.BeginUndoScope("Modify Control")

With Application.ActiveWindow.Page.Shapes.ItemFromID(>1104)
.CellsSRC(visSectionControls, 0, visCtlX).FormulaU = "Width*0.6"
.CellsSRC(visSectionControls, 0, visCtlY).FormulaU = "Height*1"
End With

End Sub

Didn't work.

I tried also other solutions like:

http://visguy.com/vgforum/index.php?topic=887.0

https://bvisual.net/2021/01/02/referencing-visio-shapes/

but they didn't work either.

How could I do the batch text moving by using the simple VBA code in Visio?

enter image description here

UPDATE:

Thanks to this query I've managed to get the shape ID and type.

How to get shape type in Visio using VBA?

and the situation looks like this:

enter image description here

Now I wanted to select all of them, as per this query: http://visguy.com/vgforum/index.php?topic=6685.0

with the code as follows:

Sub Eselde()
Dim Vshp As Visio.Shape
Dim IP As Long
For Each Vshp In ActivePage.Shapes
If Vshp.Name Like "*Fibre Cable" Then
.CellsSRC(visSectionControls, 0, visCtlX).FormulaU = "Width*0.6"
.CellsSRC(visSectionControls, 0, visCtlY).FormulaU = "Height*1"
End If
Next

End Sub

but at the line:

   .CellsSRC(visSectionControls, 0, visCtlX).FormulaU = "Width*0.6"

I get an error:

Invalid or unqualified reference

Wondering why this code cannot work in these circumstances, whereas it was working for single ID.

UPDATE II:

I've noticed, that after this approach:

Dim Vshp As Visio.Shape

For Each Vshp In VPage.Shapes
If Vshp.Name = "Fibre Cable" Then
Debug.Print Vshp.ID & " - " & Vshp.Master.Name
End If
Next
End Sub

only the first shape is taken into account, whereas I have at least 30.

enter image description here

Upvotes: 0

Views: 618

Answers (1)

Surrogate
Surrogate

Reputation: 1734

Please try this code

Sub bbb()
Dim sl As Selection, ShpObj As Shape, vl As Single
Set sl = ActivePage.CreateSelection(visSelTypeByLayer, , "Connector") ' create selection from 'Connector' layer
For Each ShpObj In sl ' iterate items in selection
    vl = ShpObj.CellsSRC(visSectionControls, 0, visCtlX) - 1 ' get X text position coordinate to left per inch
    ShpObj.CellsSRC(visSectionControls, 0, visCtlX).FormulaU = Chr(34) & vl & Chr(34) ' move text position
Next
End Sub

How this code works at my side.

Move connectors text position

Updated

Wondering why this code cannot work in these circumstances, whereas it was working for single ID.

Please add prefix with shape's variable like Vshp.CellsSRC(visSectionControls, 0, visCtlX).FormulaU = "Width*0.6"

Upvotes: 1

Related Questions