Iterate through shapes on page in Word

[Wrathchild]

I have code to look at every shape in a Word doc and if it's named a certain name then return the page#. I only care if said shape is on an Even page. Currently searching the entire doc is slow so I'd like to only search shapes on Even pages. How do I iterate through shapes on an individual page in Word?

Currently using
...
Set objWord = CreateObject("Word.Application")
For Each S In objWord.ActiveDocument.Shapes
If objWord.ActiveDocument.Shapes(intI).Name = "Barcode" Then

Would like something like
For Each S In objWord.ActiveDocument.CurrentPage

 

[Wrathchild]

Please note I'm all set with determining even/odd pages; just looking for instruction on accessing the shapes on an individual page.

 

[SkipVought]

hi,

Did you notice that in MS Word VBA Help, you found ActiveDocument, ActiveWindow, ActivePane... seems ActiveEverythingButPage!

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[Wrathchild]

I should have mentioned, yes I've seen that but I guess I don't quite understand HOW to use it as .ActivePage is never available when I get the dropdown of methods. Obviously I'm doing something wrong but my googling didn't return a good example for troubleshooting.

 

[SkipVought]

Selects shapes on even pages.

Sub test()
    Dim oPage As Page, iRec As Integer, o As Object, i As Integer
    Set o = ActiveDocument.ActiveWindow _
    .Panes(1).Pages(2).Rectangles
        
    For Each oPage In ActiveDocument.ActiveWindow.Panes(1).Pages
        i = i + 1
        If i Mod 2 = 0 Then
            For iRec = 1 To oPage.Rectangles.Count
                With oPage.Rectangles(iRec)
                    If .RectangleType = 1 Then
                       .Range.ShapeRange.Select
                    End If
                End With
            Next
        End If
    Next
End Sub

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[macropod]

An alternative approach for processing even pages:

Sub Demo()
Application.ScreenUpdating = False
Dim i As Long, j As Long, Rng As Range
With ActiveDocument
  For i = 2 To .ComputeStatistics(wdStatisticPages) Step 2
    Set Rng = ActiveDocument.GoTo(What:=wdGoToPage, Name:=i)
    Set Rng = Rng.GoTo(What:=wdGoToBookmark, Name:="\page")
    With Rng
      For j = 1 To .ShapeRange.Count
        If .ShapeRange(i).Name = "Barcode" Then
          MsgBox "Found on page: " & i
        End If
      Next
    End With
  Next
End With
Application.ScreenUpdating = True
End Sub

At a more basic level, though, any shape names in a document must be unique. Accordingly, it is not possible to have more than one shape named "Barcode". So, if all you want to do is to find out which page the "Barcode" shape is on, all you need is something along the lines of:

Sub Demo()
MsgBox ActiveDocument.Shapes("Barcode").Anchor.Information(wdActiveEndPageNumber)
End Sub

Cheers
Paul Edstein
[MS MVP - Word]

 

[Wrathchild]

Thanks for the replies. I had some time today to look at them but was unsuccessful in trying to implement them. Macropod - it is possible to have multiple shapes named "Barcode" as my code is working, just slowly. I figured I should put my code in for reference and see if it can be adjusted.

I am currently working with word documents ~6000pgs and the code below works, albeit slowly. Since I'm iterating through all shapes, I'd like to just iterate through shapes on even pages. Can I go to a specific (even) page, iterate through the shapes for "Barcode" then proceed along? This is what I'm not clear on...can I have something like 'For Each S In objWord.ActiveDocument.Currentpage.Shapes' maybe by setting a range on that one page. Macropod, your code seemed to completely lock up my instance of Word, presumably due to the size of the document I'm working with.

Please ignore the superfluous DIMs and commented lines...I'm trying different things

Function Work()
Dim strTemplateName As String
strTemplateName = "DOC TECH TEST.doc"
    On Error GoTo ErrorHandler
    Dim sysObject As FileSystemObject
    Dim sysFile As File
    Dim sysFolder As Folder
    Dim strFileName As String
    Dim strPath As String
    Dim strsql As String
    Dim shpe As Word.Shapes
    Dim intI As Integer
    Dim S As Word.Shape
    Dim textBoxName As String
    Set objWord = CreateObject("Word.Application")
    objWord.Visible = True
    objWord.Options.ReplaceSelection = True
    Set sysObject = CreateObject("Scripting.FileSystemObject")
    strPath = CurrentDBDir
    intI = 1
    Dim varIPPage As Variant
    Dim results As String
    Dim pag As Word.Page
    'Dim varTotalPages As Variant
    Dim x As Variant
    Dim rng As Range
        objWord.Documents.Open (CurrentDBDir & strTemplateName)
        For Each S In objWord.ActiveDocument.Shapes
                varIPPage = Selection.Information(wdActiveEndPageNumber)
                    'If varIPPage Mod 2 = 1 Then Selection.Goto What:=wdGoToPage, Which:=wdGoToNext, Count:=1
                    'varIPPage = varIPPage + 1
                    If objWord.ActiveDocument.Shapes(intI).Name = "Barcode" Then
                        objWord.ActiveDocument.Shapes(intI).Select
                        Debug.Print objWord.ActiveDocument.Shapes(intI).Name
                            Debug.Print varIPPage
                            If varIPPage Mod 2 = 0 Then
                                If results = "" Then
                                    results = varIPPage
                                Else
                                    results = results & ", " & varIPPage
                                End If
                            End If
                    End If
                intI = intI + 1
                Err.Clear
        Next S
MsgBox "Issue found with coversheet on page(s) " & results
ExitHere:
    On Error Resume Next
    Exit Function
ErrorHandler:
    Resume ExitHere
End Function

 

[macropod]

So how are you naming the shapes?

With ~6000 pages to process, Word is obviously going to require considerable time for all the page-by-page processing. With the code I posted, you could usefully insert 'DoEvents' just before the final 'Next', so as to give Word some breathing space for its housekeeping. You could also give a progress count via 'Application.StatusBar = "Processing page: " & i' at the same location, followed by 'Application.StatusBar = "Done!!"' before the last 'End With'.

Cheers
Paul Edstein
[MS MVP - Word]