Custom report using multiple user-defined cells

[abssorb]

I have a milestone chart, where each milestone has a number of user-defined cells relating to its status.

What I'd like to be able to do is have a report which does this:

Count every shape which is a milestone (user.milestone=1),
Of these, sub-total which are:

• Status red (user.status=red)
  
• Status green (user.status=green)
  
• Approved (user.approval=1)
  
• Not Approved (user.approval<>1)
  

I can make simple reports, totaling any one of these, and then assemble it all in excel, but that's a pain.  I'd like to learn how to build this into a single visio report is possible.

Any help appreciated.

[Jumpy]

Do it yourself in VBA?

Code Select Expand


Dim total as Integer, stRed as Integer, stGreen as Integer, Appr as Integer, NotAppr as Integer
Dim shp as Visio.Shape

For Each shp in ActivePage.Shapes
  If shp.CellExists("User.milestone",false) Then
    If shp.Cell("User.milestone").Result("") = 1 Then
      total = total +1
      If shp.Cell("User.Status").ResultStr("") = "red" Then stRed = stRed + 1
      If shp.Cell("User.Status").ResultStr("") = "green" Then stGreen = stGreen + 1
      If shp.Cell("User.approval").Result("") = 1 Then
        Appr = Appr + 1
      Else
        NotAppr = NotAppr + 1
      End If
    End If
  End If
Next

'Now push that all to Excel
'Don't know the exact Code from here on

  Dim e as Excel.Application
  Set e = CreateObject("Excel.Application")

  Dim w as Workbook
  Set w = e.Workbooks.Add 'or e.Workbooks.Open("MyWorkbook.xls")

  Dim ws as Worksheet
  Set ws = w.Worksheets(1)
 
  ws.Cells(2,2).Value = Total
  ws.Cells(3,2).Value = stRed
  ws.Cells(4,2).Value = stGreen
  ws.Cells(5,2).Value = Appr
  ws.Cells(6,2).Value = NotAppr

  'Save, Quit, Cleanup
  w.Save 'w.SaveAs(SomeArguments)
  Set ws = Nothing
  w.Close
  Set w = Nothing
  e.quit
  Set e = Nothing


As an idea for starters...

[abssorb]

Many thanks Jumpy.  I will investigate

The client has macro restrictions on their network though.