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.
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
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.
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 (https://support.office.com/en-us/article/create-or-edit-an-index-in-a-database-model-diagram-5e4ff6ed-ebd2-4930-bc8c-88490ba1de9a)
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.
For Each is done in a pre-defined order, this cannot be changed. A normal For loop can work in forward or reverse direction:
For i = 1 To 10
do stuff
Next i
or
For i = 1 To 10 step -1
do stuff
Next i
QuoteAnother 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.
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.
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
...and now the Visio drawing example