Auto number shape property in relation to position on page

[hill041]

Hi everyone!

I'm trying to write some code to do a similar thing to the 'Number Shapes' Add On. I need it to add a property called Prop.PositionNumber to each shape and increment this number relative to each shape's position on the page (left to right, then top to bottom).

Anyone got any idea how i can do this?

Thanks in advance,

Daniel.

[Yacine]

Hello Daniel,
you could the following:
- identify the shapes to number:
* loop over the shapes of the page: for each shp in activepage.shapes...
* either they have a specific property - eg the existance or the value of a field:
  ** if shp.cellexists("prop.myField",false) then ...
  ** if shp.cells("prop.myfield").resultstr("") = "myValue"...
* or you identify them by selecting them:
  for each shp in activewindow.selection...

for each identified shape you would add the prop field "PositionNumber": shp.addnamedrow vissectionprop, "PositionNumber", visrowlast
You would in the same loop also store the coordinates of the shape in an appropriate data structure eg an array:
  pos(0,i) = shp.ID()
  pos(1,i) = shp.cells("pinx").resultUI
  pos(2,i) = shp.cells("pinY").resultUI

Having built up the array, you will then need to sort its values by x (left to right) and y (descending, to get it top to bottom). Store the value in pos(4,i).
Mind that if you don't cluster the x values, there might be no sorting of the y values.
For sorting algorithms, please rely on Google.

Having sorted the array, you can now assign the sort order to prop.positionnumber: shp.cells("prop.positionnumber").formulau = pos(4,i)

HTH,
Yacine

[wapperdude]

Another approach might be to ship the data / array to Excel and let it do the sort. 

I think initially, array has 3 columns:  shape ID, Xpos, YPos.  Excel sorts based upon Xpos 1st, Ypos 2nd.  This will put the shape IDs in the desired positional order. 

[wapperdude]

Found this, might be useful:  https://support.office.com/en-us/article/create-or-edit-an-index-in-a-database-model-diagram-5e4ff6ed-ebd2-4930-bc8c-88490ba1de9a

[hill041]

Thanks for the help guys, its all a little too complicated for my little brain and I would really not like to use excel.

I wonder if there is a way to change the order in which VBA carries out a For Each loop. Its currently seems to attack each shape in the reverse order in which it was placed on the page.

[Paul Herber]

For Each is done in a pre-defined order, this cannot be changed. A normal For loop can work in forward or reverse direction:

Code Select Expand

For i = 1 To 10
    do stuff
Next i


or

Code Select Expand

For i = 1 To 10 step -1
    do stuff
Next i


[Croc]

Another approach might be to ship the data / array to Excel and let it do the sort.

Mind that the tool "Visio Report" has the ability to sort. Including coordinates. That is, you can load into Excel already sorted data.

[wapperdude]

Below is code to place shape order position into shape text.  Unfortunately, I'm having some issues posting actual files at the moment...

The "comstr" code line is critical.  It defines the location of the reports file (vrd), and the Excel file (xlsx).  These locations must be pre-existent.  The vrd is a modified Inventory report, saved in the indicated location.  Note, these entries must be edited to match your computer configuration.  The modified Inventory report uses just shape ID, xpos, and ypos.  No filtering.  Sorting is by Ypos 1st, decending, then Xpos, ascending.  As this is based upon PinY and PinX values at center of each shape, the actual order may seem odd at times.

Below is the modified vrd report file.

Code Select Expand


Sub FetchExcelData2()
    Dim XlApp As Object
    Dim XlWrkbook As Excel.Workbook
    Dim XlSheet As Excel.Worksheet
    Dim myUsedRng As Range
    Dim LastRow As Long
   
    For Each pg In Visio.ActiveDocument.Pages                                                        'this loops thru every page in Visio document
        Debug.Print pg.Name                                                                                   'all debug.print lines may be commented out.
        Visio.ActiveWindow.Page = pg                                                                       'this makes the page active
        ComStr = "/rptDefName=D:\Reports\ShapePos.vrd /rptOutput=EXCEL " & _    'modify file path and vrd filename as necessary
                 "/rptOutputFilename=D:\Reports\Rpt\Ex.xlsx /rptSilent=True"               'modify file path and xlsx filename as necessary.  Manually create the Rpt directory before running code
        Visio.Application.Addons("VisRpt").Run (ComStr)
                                 
        Set XlApp = GetObject(, "Excel.Application")                                                  'this and following lines define Excel environment
        Set XlWrkbook = XlApp.Workbooks.Open("D:\Reports\Rpt\Ex.xlsx")                'update xlsx info to match ComStr info above.
        Debug.Print XlWrkbook.Name                                               
        Set XlSheet = XlWrkbook.Sheets("Sheet1")
        Debug.Print XlSheet.Name
   
        Set myUsedRng = XlSheet.UsedRange
        LastRow = myUsedRng.Rows.Count                      'This is last populated row.
       
        With XlSheet
            For iRow = 3 To LastRow                                 'This loops thru first column of Excel file.  Data begins with row = 3, and pastes values into respective shape.
                vsoshpid = .Cells(iRow, 1).Value
                Set vsoshp = Visio.ActivePage.Shapes.ItemFromID(vsoshpid)    'This selects the respective shape on the active page.
                vsoshp.Text = ""
                vsoshp.Text = "Position: " & iRow - 2                                       'This places Excel info into shapetext.  Different scenarios are possible:  shape data, User defined cell in shapesheet
                Debug.Print vsoshp.Name & "    " & vsoshp.Text
            Next
        End With
        XlWrkbook.Close 'savechanges:=False
        XlApp.Quit
        Set XlApp = Nothing
    Next
'    MsgBox "Done"
End Sub


[wapperdude]

...and now the Visio drawing example