Exporting/Reporting Shape data field for top shape on each page or an Org Chart

[WCTICK]

I used the Create Org Chart wizard to import data from an excel spreadsheet.  Once imported, I had to do a decent amount of rearranging and moving to get the chart displayed as we want it.  The chart consists of almost 90 pages.

There is a shape data field called, "Position Number" that is the unique field that was used when the external data was linked to the shapes.

I am trying (unsuccessfully) to find a way to create a report or file that lists the position number from the top shape on each page and also the name of the page.  The page names were changed manually when the rearranging was done. 
For example:

Page Name                  Position Number from top shape on each page

Directors Office            200100
CIO                             200150

Any suggestions?

[Yacine]

Code Select Expand


Option Explicit

Sub getTopShapes()
  Dim pg As Page
  Dim shp As Shape
  Dim ar_pg As Variant
  Dim ar_pgs As Variant
  Dim v As Variant
  Dim temp As String
  Dim temp2 As String
 
  For Each pg In ActiveDocument.Pages
    For Each shp In pg.Shapes
      If shp.CellExists("prop.ID", False) Then
        temp = temp & Format(shp.Cells("PinY").ResultIU, "0.000000") & "|" & shp.ID & "|" & pg.Name & "§"
      End If
    Next shp
    temp = Left(temp, Len(temp) - 1)
    ar_pg = Split(temp, "§")
    ar_pg = BubbleSort(ar_pg)
    temp2 = temp2 & ar_pg(0) & "§"
   
  Next pg
  ar_pgs = Split(temp2, "§")

  For Each v In ar_pgs
    Debug.Print v
  Next v
End Sub


Function BubbleSort(ByVal myArray As Variant) As Variant
    Dim i As Long, j As Long
    Dim temp As Variant
   
    For i = LBound(myArray) To UBound(myArray) - 1
        For j = i + 1 To UBound(myArray)
            If myArray(i) > myArray(j) Then
                ' Swap elements
                temp = myArray(i)
                myArray(i) = myArray(j)
                myArray(j) = temp
            End If
        Next j
    Next i
   
  BubbleSort = myArray
End Function



... and now I recall why I prefer Python over VBA. Handling collections of data is just so awful in VBA.
Look how neat it would look in Python.

Code Select Expand


L1 = []
L2 = []
for pg in vDoc.Pages:
  for shp in pg.Shapes:
    if shp.CellExists('PinX',False):
      L1.append([shp.Cells('PinX').ResultIU, shp.ID, pg.Name])
  L1.sort()
  L2.append(L1[0])
  L1 = []
print(L2)


No concatenation of list members into one string, just a list of lists.
No separately implemented sort algorithm, the fundamental basics are built in.
Getting a handle in the active document (vDoc) requires some lines of code, but that is written in a library that is re-used over and over. I can provide it, if wished.

[WCTICK]

Thank you for your response... and I apologize for my ignorance regarding VBA/Visio.

I copied the code and changed the cellexists statement to shp.CellExists("prop.Position Number", False) Then

since the shape data field I am attempting to get is named Position Number.

The statement after the "Then" parameter, never gets reached.

Do you have any idea what I am messing up?

[Yacine]

I'm pretty sure your field "prop.Position Number" is not named so.
Prop rows don't allow space chars in their naming. You may have taken the name from the label column.
You must take the name upmost left of the row, the very first entry on the left.


And sorry for having been so short in my previous answer.

[WCTICK]

You were correct.  I was using the label name instead of the field name.  Thanks!