Count of Shapes With Specific Shape Data Value

Started by mkidwel, August 02, 2011, 01:36:36 PM

Previous topic - Next topic

0 Members and 1 Guest are viewing this topic.

mkidwel

I need to get a count of shapes that have a specific shape data value (Count where Prop.ShapeData1 = "SOME_VALUE").  Anyone know how I could do that?

aledlund

a single page, or the whole document? what does your code currently look like?
al

mkidwel

The whole document.  I have zero experience with VB other than recording macros and doing minor tweaks so I started with some code I saw online (might have even been yours) and was hoping to trim it down to just provide the count for the whole document, but I'm stuck.

Dim visDoc As Visio.Document
Dim visPage As Visio.Page
Set visDoc = Application.ActiveDocument
Dim intPage As Integer
Dim intCount As Integer
intCount = 0
Dim intTotal As Integer
intTotal = 0
Dim mstrtyp As Visio.Shape
mstrtyp.Cells("Prop.MstrType").Value = "Opportunity"
For intPage = 1 To visDoc.Pages.Count
Set visPage = visDoc.Pages(intPage)
intCount = visPage.Shapes.Count
intTotal = intTotal + intCount
MsgBox "Page " & intPage & " has " & CStr(intCount) & " shapes"
Next intPage
MsgBox "Total Shapes = " & intTotal

Jumpy

Q+D and created without Visio but should work:


Sub Counter()
  Dim pg As Visio.Page, shp As Visio.Shape
  Dim intCount As Integer, intTotal As Integer
  intTotal = 0

  For Each pg in ActiveDocumet.Pages
    intCount = 0
    For Each shp in pg.Shapes
      If shp.CellExists("Prop.ShapeData1",false) Then
        If shp.Cells("Prop.ShapeData1").ResultStr("") = "SomeValue" Then intCount = intCount + 1
       'or: If shp.Cells("Prop.ShapeData1").Result("") = 42 Then intCount = intCount + 1
       'or: If shp.Cells("Prop.ShapeData1").FormulaU = "SomeFormula" Then intCount = intCount + 1
      End If
    Next shp
    MsgBox "There are " & intCount & " Shapes with your value on page " & pg.Name
    intTotal = intTotal + intCount
  Next pg

  MsgBox "There are " & intTotal & " Shapes with your value in the document"
End Sub

mkidwel