VBA to get text from shapes sorted by lane title?

[vanncad]

Hi, I am trying not to re-invent the wheel here. Maybe there is some code here that already does this.

I have a cross-functional chart with 3 lanes.
I want to extract the text from the process boxes in each of these lanes so I can create  a procedure document for each person.

For example (see the attached GroceryProcess jpeg)
I would like to end up with:
Dad

• Go to work
• Get Paid
• Give money to mom
• Go hungry

Mom

• Drive to grocery store
• Buy groceries
• Put groceries away

etc.

I have done some Visio VBA programming, but am not quite sure how to detect which process belongs to which lane.

TIA,

- Vann

[vanncad]

Is this even possible?

[JuneTheSecond]

Hi,

In Visio 2010 TP, shape has a data, custom property, about where is it.(Image1.jpg)
It uses Container, new feature, great enhancement.
In Visio 2007, how about using Shape.SpatialNeighbors property?

[Visio Guy]

Visio 2007 adds special User-cells to shapes placed in swimlanes: User.yTop and User.yBottom. You can use this information to see which lanes a shape starts and ends in. If a shape spans more than two lanes, though, you don't get any info about which lanes are in between. Just the top and bottom.

I assume there are User.yLeft and User.yRight cells for vertical swimlane diagrams.

This code walks the shapes in a swimlane diagram and uses the Precedents property on the User cells to find out the lane for each shape. Note: most of the work is in the Sub m_isInLane, down at the bottom, so be sure to check that out. The top Sub is really just looping through the shapes on the page and outputting text to the Debug window:

Code Select Expand


Sub DumpSwimlaneMembershipInfo()

  Dim pg As Visio.Page
  Set pg = Visio.ActivePage
 
  Dim shp As Visio.Shape
  Dim topId As Integer, bottomId As Integer
 
  Dim msg As String
 
  For Each shp In pg.Shapes
 
    If m_isInLane(shp, topId, bottomId) Then
     
      If (topId = bottomId) Then
        msg = "Shape [ShapeID] ([ShapeText]) is in lane: [LaneID1] ([LaneText1])."
        msg = Replace(msg, "[ShapeID]", shp.ID)
        msg = Replace(msg, "[ShapeText]", shp.Text)
        msg = Replace(msg, "[LaneID1]", topId)
        msg = Replace(msg, "[LaneText1]", pg.Shapes.ItemFromID(topId).Text)
        msg = Replace(msg, "[LaneID1]", topId)
        msg = Replace(msg, "[LaneText1]", pg.Shapes.ItemFromID(topId).Text)
       
        Debug.Print msg
     
      Else
        msg = "Shape [ShapeID] ([ShapeText]) spans lanes: [LaneID1] ([LaneText1]) to [LaneID2] ([LaneText2])."
        msg = Replace(msg, "[ShapeID]", shp.ID)
        msg = Replace(msg, "[ShapeText]", shp.Text)
        msg = Replace(msg, "[LaneID1]", topId)
        msg = Replace(msg, "[LaneText1]", pg.Shapes.ItemFromID(topId).Text)
        msg = Replace(msg, "[LaneID2]", bottomId)
        msg = Replace(msg, "[LaneText2]", pg.Shapes.ItemFromID(bottomId).Text)
       
        Debug.Print msg
     
      End If
   
    End If
 
  Next shp

End Sub

Private Function m_isInLane(ByRef shp As Visio.Shape, ByRef topId As Integer, ByRef bottomId As Integer) As Boolean

  '// Be pessimistic:
  m_isInLane = False
 
  Dim cells() As Visio.cell
  Dim cell As Visio.cell
 
  '// See if shp has the secret swimlane cells:
  If (shp.CellExists("User.yTop", Visio.VisExistsFlags.visExistsLocally)) Then
    If (shp.CellExists("User.yBottom", Visio.VisExistsFlags.visExistsLocally)) Then
      m_isInLane = True
     
      cells = shp.cells("User.yTop").Precedents
      topId = cells(1).Shape.ID
     
      cells = shp.cells("User.yBottom").Precedents
      bottomId = cells(1).Shape.ID
     
    End If
  End If

End Function



For the swimlane pictured in the image below, the above code yields:

Code Select Expand


Shape 11 (Sue) is in lane: 8 (Lane 2).
Shape 12 (Bob) is in lane: 5 (Lane 1).
Shape 13 (Frank) is in lane: 14 (Lane 3).
Shape 17 (Fat Albert) spans lanes: 5 (Lane 1) to 14 (Lane 3).


The numbers are the shape ids, the text in parentheses are the text bits on each shape, of course.

[vanncad]

Wow! This is great!

Thank you both very much for your responses (and especially the code Visio Guy).

I will try to hammer something out using these solutions and will post something here if I get a satisfactory result.

Thank you both again for your time and sharing your knowledge.

Sincerely,

- Vann