<SOLVED>Select shapes by custom field text, and sort in page.

Started by Lucali, February 05, 2020, 09:52:40 PM

Previous topic - Next topic

0 Members and 1 Guest are viewing this topic.

Lucali

Good afternoon to all, i need help if its possible on following problem,  the user generates the shape from external data, it becomes messy when he selects several rows and drops them to the page.
Each box represents a type of data, represented in a custom MDTYPE field that can be S, C, R or V in that order (there may be 4 or any of them) .
I would like to achieve, (I was not successful) select, according to MDTYPE is S for example, and sort them to the right, then look for if there is MDTYPE C and sort them under S, also to the right.
In attached document, you can find pictures about for more details.
If its is possible, It would save me a lot of time, since I have to order many diagrams like this manually and it won't be programmed. I have tried to follow some examples of the forum, but I have not even been able to select the shape according to the custom MDTYPE  :-\
Thank you very much in advance.
Lu

wapperdude

Here's format for your code.  Needs editing to get correct row name, and you need to decide where to place the shapes.  This is setup for 3 variations.


Sub order()
    Dim shp As Visio.Shape
    Dim i, j, k As Double
   
    i = 1#
    j = 1#
    k = 1#
       
    For Each shp In ActivePage.Shapes
        If shp.CellExists("User.WhoAmI", visExistsLocally) Then
            who = shp.Cells("User.WhoAmI").ResultStr(visNone)
            Select Case who
            Case "A"
'                Debug.Print i, who
                shp.Cells("PinX").Formula = i
                shp.Cells("PinY").Formula = 9
                i = i + 1.5
               
            Case "B"
'                Debug.Print j, who
                shp.Cells("PinX").Formula = j
                shp.Cells("PinY").Formula = 6
                j = j + 1.5
               
            Case "C"
'                Debug.Print k, who
                shp.Cells("PinX").Formula = k
                shp.Cells("PinY").Formula = 3
                k = k + 1.5
            End Select
        End If
    Next
End Sub
Visio 2019 Pro

Yacine

#2
Wapperdude's solution would normally work, but your settings prevent the function "cellexists" to work properly.
The actual name of the field is "Prop._VisDM_MDTYPE". I don't know whether it's the leading underscore or another reason, but the a.m. function never finds the field.
A nice way to prevent Visio from adding those ugly "_VisDM_"s on front of the fields is to properly prepare the shapes with the right fields (both the actual name and the label).
Addressing the field directly - as long as it exists - worked fine however. So instead of checking if cellsexists, I opted to move the processing to a separate sub, that exits on error (eg field does not exist).
Option Explicit

Dim s As Integer
Dim c As Integer
Dim r As Integer
Dim v As Integer

Sub arrange()
    Dim shp As Shape
   
    s = 0
    c = 0
    r = 0
    v = 0
   
    For Each shp In ActivePage.Shapes
        set_pos shp
    Next shp

End Sub

Sub set_pos(shp As Shape)
On Error GoTo sub_exit
   
    Dim mdtype As String
    Dim left_margin As Integer
    Dim horiz_gap As Integer
    Dim bottom_margin As Integer
    Dim vert_gap As Integer
   
    left_margin = 100
    horiz_gap = 120
   
    bottom_margin = 250
    vert_gap = 60
   
    mdtype = shp.CellsU("Prop._VisDM_MDTYPE").ResultStr("")
   
    Select Case mdtype
    Case "S":
        s = s + 1
        shp.Cells("PinY").Formula = (bottom_margin + 4 * vert_gap) & "mm"
        shp.Cells("PinX").Formula = (left_margin + horiz_gap * s) & " mm"
    Case "C":
        c = c + 1
        shp.Cells("PinY").Formula = (bottom_margin + 3 * vert_gap) & "mm"
        shp.Cells("PinX").Formula = (left_margin + horiz_gap * c) & " mm"
    Case "R":
        r = r + 1
        shp.Cells("PinY").Formula = (bottom_margin + 2 * vert_gap) & "mm"
        shp.Cells("PinX").Formula = (left_margin + horiz_gap * r) & " mm"
    Case "V":
        v = v + 1
        shp.Cells("PinY").Formula = (bottom_margin + 1 * vert_gap) & "mm"
        shp.Cells("PinX").Formula = (left_margin + horiz_gap * v) & " mm"
    End Select
sub_exit:
End Sub
Yacine

Lucali

Quote from: Yacine on February 07, 2020, 09:15:01 AM
Wapperdude's solution would normally work, but your settings prevent the function "cellexists" to work properly.
The actual name of the field is "Prop._VisDM_MDTYPE". I don't know whether it's the leading underscore or a another reason, but the a.m. function never finds the field.
A nice way to prevent Visio from adding those ugly "_VisDM_"s on front of the fields is to properly prepare the shapes with the right fields (both the actual name and the label).
Addressing the field directly - as long as it exists - worked fine however. So instead of checking if cellsexists, I opted to move the processing to a separate sub, that exits on error (eg field does not exist).
Option Explicit

Dim s As Integer
Dim c As Integer
Dim r As Integer
Dim v As Integer

Sub arrange()
    Dim shp As Shape
   
    s = 0
    c = 0
    r = 0
    v = 0
   
    For Each shp In ActivePage.Shapes
        set_pos shp
    Next shp

End Sub

Sub set_pos(shp As Shape)
On Error GoTo sub_exit
   
    Dim mdtype As String
    Dim left_margin As Integer
    Dim horiz_gap As Integer
    Dim bottom_margin As Integer
    Dim vert_gap As Integer
   
    left_margin = 100
    horiz_gap = 120
   
    bottom_margin = 250
    vert_gap = 60
   
    mdtype = shp.CellsU("Prop._VisDM_MDTYPE").ResultStr("")
   
    Select Case mdtype
    Case "S":
        s = s + 1
        shp.Cells("PinY").Formula = (bottom_margin + 4 * vert_gap) & "mm"
        shp.Cells("PinX").Formula = (left_margin + horiz_gap * s) & " mm"
    Case "C":
        c = c + 1
        shp.Cells("PinY").Formula = (bottom_margin + 3 * vert_gap) & "mm"
        shp.Cells("PinX").Formula = (left_margin + horiz_gap * c) & " mm"
    Case "R":
        r = r + 1
        shp.Cells("PinY").Formula = (bottom_margin + 2 * vert_gap) & "mm"
        shp.Cells("PinX").Formula = (left_margin + horiz_gap * r) & " mm"
    Case "V":
        v = v + 1
        shp.Cells("PinY").Formula = (bottom_margin + 1 * vert_gap) & "mm"
        shp.Cells("PinX").Formula = (left_margin + horiz_gap * v) & " mm"
    End Select
sub_exit:
End Sub


Thank youuu thankyouuu thank you...thanks to both of you for your help. Yacine, your way of reasoning the code is fabulous and clear, thank you very much for your example, it is just what I was looking for and with this you already give me a hint of how to make selections from macros.
Regards and have a nice days.
Lu