help translating psuedocode

[desertsp]

Can anyone help me convert this "pseudocode" to real VBA? Basically, what I want to do is, for every trapezoid on a given page, insert below the trapezoid a text list of page numbers with shapes that contain the text within the trapezoid.

The purpose is to make it easier to read multi-page process diagrams where the input to a process may have been created several pages back, or the output of a process may be used several pages forward.

Code Select Expand


For every shape on current page
  if shape is trapezoid then 'only for trapezoids
    curtext= shape.text 'the text contained within the shape (always a single string)
   
      for every other page 'look on all other pages for matches
        for every shape 'look at every shape, on every page
          if shape.text = curtext then 'if text matches

            curpage = page.number 'get the page number where a match was found
            pagelist = pagelist & "," & curpage 'add it to a growing list (text string)
           
  if pagelist is not null  then   'if the list had at least one item, insert the string next to the trapezoid
    insert a textbox with the list of page numbers. place textbox near the trapezoid.
   
next shape


Thank you!

[Jumpy]

Only a start (created in the editor without Visio, so may contain errors):

Code Select Expand


Privat Function IsTrapezoid(ByRef shp as Visio.Shape) as Boolean
  'Here you need to decide if a shape is trapezoid or not, not knowing your shapes I can't help with that
  'Maybe the shapes have a comen mastershape, or a special porperty or user defined cell in the ShapeSheet
End Function

Private Sub AddToList(ByRef List as Collection,Pagenumber as integer)
  Dim nr as Variant
  For Each nr in List
    If CINT(nr)=Pagenumber then Exit Sub 'Don't add a pagenumber twice
  Next nr
  List.Add Pagenumber
End Sub

Public Sub SearchForTrapezoids()
  Dim CurrentPage as Page, pg as Page, CurrentShape as Shape, shp as Shape
  Dim Pagelist as Collection

  Set CurrentPage=ActivePage

  For Each CurrentShape in CurrentPage.Shapes
    If IsTrapezoid(CurrentShape) then
      Set Pagelist = New Collection
      For Each pg in ActiveDocument.Pages
        If pg<>CurrentPage Then 'Don't count the current page
          For Each shp in pg.Shapes
            If IsTrapezoid(shp) then
              If shp.Text=CurrentShape.Text Then
                AddToList(Pagelist,pg.Number)
              End If
            End If
          Next shp
        End If
      Next pg
      If Pagelist.Count>0 then PlacePagelistNearCurrentShape(CurrentShape,Pagelist)
    End If
  Next CurrentShape
End Sub

Private Sub PlacePagelistNearCurrentShape(ByRef CurrentShape as Shape, Pagelist as Collection)
  Dim text as String, X as Double, Y as Double, v as Variant

  'Offset in mm for placing textshape near (here below) currentshape
  Const OffsetX as Double = 0
  Const OffsetY as Double = -30

  'Eventually place code here to sort Pagelist first 

  For Each v in Pagelist
    If text<>"" then text=text & ", "
    text=text & CSTR(v)
  Next v

  'Get Position of New textshape = Position of Current Shape + Offset
  X=CurrentShape.Cells("Pinx").Result("mm")+OffsetX
  Y=CurrentShape.Cells("PinY").Result("mm")+OffsetY

  'Now here place the code to Add a new textshape at position X/Y
  'Can't help with that without Visio
End Sub


[desertsp]

Thanks Jumpy, I appreciate the extra details you added too!

I will try this, hopefully this week, and then post finalized code or any follow-up questions.