Page count

[chathavardhan]

Hello all,

I have created a viso file with 20 pages and i have dropped few shapes in all the pages now i want to know in how many pages i have dropped rectangle shape. page count of the pages which has only a rectangel shape. can any one please help me with a vba code to get the pagecount.


Thank's in advance

[chathavardhan]

I am using this program to list the shapes in one page

Public Sub setpoint()
Dim Searchnumber As String, Searchtext As String
Dim Pageobj As Visio.Page
Dim CellObj   As Visio.Cell
Dim PosY  As Double, PosX As Double
Dim PageCnt, shapecnt As Integer
Dim i As Integer
      Searchtext = "TITLE"
      PageCnt = 0
      PageCnt = ActiveDocument.Pages.Count - 1
      Set SNo1 = ActiveDocument.Pages("SETPOINT").DrawRectangle(0.75, 10.5, 1.25, 10.75)
      SNo1.Text = "TAG"
      Set Sh1 = ActiveDocument.Pages("SETPOINT").DrawRectangle(1.25, 10.5, 2.25, 10.75)
      Sh1.Text = "SHEET NO."
      Set Title1 = ActiveDocument.Pages("SETPOINT").DrawRectangle(6.25, 10.5, 2.25, 10.75)
      Title1.Text = "DESCRIPTION"
      Set Tag1 = ActiveDocument.Pages("SETPOINT").DrawRectangle(6.25, 10.5, 8.25, 10.75)
      Tag1.Text = "SP VALUE"
For Each Pageobj In ActiveDocument.Pages
      PageCnt = PageCnt + 1
If Not (Pageobj.Name = "SYMBOLS") Then
For Each Shape In Pageobj.Shapes
If Shape.Name = "LOM" Or Shape.Name = "HLM" Or Shape.Name = "HIM" Or Shape.Name = "HMH" Or Shape.Name = "LMH" Or Shape.Name = "SG" Or Shape.Name = "DHL" Then
     
      PageCnt = PageCnt - 0.5
      PosY = (PageCnt - Pageobj.Index) / 2
      Set rectangle = ActiveDocument.Pages("SETPOINT").DrawRectangle(0.75, PosY, 1.25, PosY + 0.25)
      rectangle.Text = Shape.Text
      Set rectangle1 = ActiveDocument.Pages("SETPOINT").DrawRectangle(1.25, PosY, 2.25, PosY + 0.25)
      rectangle1.Text = Pageobj.Name
      Set rectangle2 = ActiveDocument.Pages("SETPOINT").DrawRectangle(2.25, PosY, 6.25, PosY + 0.25)
      rectangle2.Text = Pageobj.Shapes("TITLE").Text
      Set rectangle3 = ActiveDocument.Pages("SETPOINT").DrawRectangle(6.25, PosY, 8.25, PosY + 0.25)
      rectangle3.Text = "LATER"

End If
Next
End If
Next

End Sub


now the problem is if i increase the pages in visio file it rearranges the order the pos Y is changing can any one please help.

[cliff50]

I tried the code in my visio.
I am not sure what the output is meant to produce , however,
could it be ....


Dim PageCnt, shapecnt As Integer 'its declared as an integer

PageCnt = 0
PageCnt = ActiveDocument.Pages.Count - 1  ' it decrements as an integer


PageCnt = PageCnt + 1

PageCnt = PageCnt - 0.5   ' it decrements by less than 1
PosY = (PageCnt - Pageobj.Index) / 2 ' it is used to alter the PosY value

[cliff50]

note also, this part of the code caused it to draw over the top of existing boxes every time the macro was actioned, is it meant to do this?

Searchtext = "TITLE"
      PageCnt = 0
      PageCnt = ActiveDocument.Pages.Count - 1
      Set SNo1 = ActiveDocument.Pages("SETPOINT").DrawRectangle(0.75, 10.5, 1.25, 10.75)
      SNo1.Text = "TAG"
      Set Sh1 = ActiveDocument.Pages("SETPOINT").DrawRectangle(1.25, 10.5, 2.25, 10.75)
      Sh1.Text = "SHEET NO."
      Set Title1 = ActiveDocument.Pages("SETPOINT").DrawRectangle(6.25, 10.5, 2.25, 10.75)
      Title1.Text = "DESCRIPTION"
      Set Tag1 = ActiveDocument.Pages("SETPOINT").DrawRectangle(6.25, 10.5, 8.25, 10.75)
      Tag1.Text = "SP VALUE"