Geographos
Geographos

Reputation: 1456

VBA Visio - autoorder items by their value (alphabetically)

I would like to have my shapes in the following manner (as the red list on the right): enter image description here

Unfortunately, my schematic comes initially in a quite chaotic order, as you can see on the left.

The alphabetical order is made only horizontally, but not vertically.

I tried to fight with the code, but it was rather swapping some "branches" around.

      ActiveWindow.Select Application.ActiveWindow.Page.Shapes.ItemFromID(925), visSelect
      ActiveWindow.Select Application.ActiveWindow.Page.Shapes.ItemFromID(1143), visSelect
      ActiveWindow.Select Application.ActiveWindow.Page.Shapes.ItemFromID(814), visSelect
      ActiveWindow.Select Application.ActiveWindow.Page.Shapes.ItemFromID(1141), visSelect
      ActiveWindow.Select Application.ActiveWindow.Page.Shapes.ItemFromID(1142), visSelect
      Application.ActiveWindow.Selection.Move 0.224972, 2.302099

      ActiveWindow.Select Application.ActiveWindow.Page.Shapes.ItemFromID(1144), visSelect
      ActiveWindow.Select Application.ActiveWindow.Page.Shapes.ItemFromID(1017), visSelect
      ActiveWindow.Select Application.ActiveWindow.Page.Shapes.ItemFromID(1072), visSelect
      Application.ActiveWindow.Selection.Move 0.151857, 2.238548

Another approach was:

    If Vshp.Name Like "*UG*" Then
        If Vshp.CellsSRC(visSectionCharacter, 0, visCharacterSize).FormulaU Like """"*NRTH-X*"""" Then

Sort Key1:=Range("SLD"), Order1:=xlAscending End If End If

I am having the error, that: Object doesn't support this property or method.

Is there a chance for ordering the shapes in ascending (alphabetical) manner, by their value, analogically to this thread: VBA visio - cannot change font size in the element

UPDATE:

Tried to work with the answer below, but I keep receiving the following error: Object variable or with variable not set

At the following line:

Sub texts()
Dim ViShp As Shape
Set ViShp = ActiveWindow.Selection.PrimaryItem
**If ViShp.Shapes(4).Characters.Text Like "*NRTH*" Then**
End If
End Sub

By this approach:

Sub textsel()
Dim ViShp As Shape
Dim Vs As Shape
Set ViShp = ActiveWindow.Selection.PrimaryItem
Set Vs = ViShp.Shapes(4)
If Vs.Characters.Text Like "*NRTH*" Then
End If
End Sub

Set Vs = ViShp.Shapes(4) - this is the line where the error appears.

Sometimes I also get this error: Requested operation is presently disabled

Run-time error '-2032465766 (86db089a)' "Requested operation is presently disabled."

Is there any way to define the object for the sub-shape?

Upvotes: 1

Views: 198

Answers (1)

Surrogate
Surrogate

Reputation: 1734

How works with text values

If you want to get the text of a shape programmatically you must use the Text property Use syntax like

If Vshp.Text Like """"*NRTH-X*"""" Then

Another way use INSTR function

If instr(Vshp.Text,"NRTH-X")>0 Then


This solution show how works with text, but not about auto-ordering!

Sorry, I forgot than text like "NRTH-X" have sub-shape.
Also in your case this sub-shape have not text, there used field.
Try use syntax
If Vshp.Shapes(4).Characters.Text Like "**NRTH-X**" Then

Please look test at my side
Sub-Shape with field

In other threads, I've written to you many times that you use an intricate way of trying figures on a page.
IMHO Best way using CreateSelection method

Upvotes: 1

Related Questions