Help please with page selection

[Dynamo]

Hi,

I have a document with 240 pages and I want to count the instances of a specific
word on each page. I am having a problem with selecting each page in turn. At
present I have the following statement.

For Numberofcharacters = 0 to 20000 step 2000
Set Myselection = ActiveDocument.Range(Start:=Numbercharacters,
End:=Numercharacters + 2000)
Next Numbercharacters

This however only selects the 2000 characters at a time and is not suitable. Any
suggestions on how I could select each page in turn?

TIA
Dynamo

 

[Ed]

Dynamo, I had somewhat of the same problem. Unfortunately, Word does not
have a Pages collection. Tables, Paragraphs, Words, Characters - yes;
Pages - no. BUT - it does have GoTo Next Page, which puts you at the top of
the next page. I used that in one of my macros, and took that and some
other stuff floating on the newsgroup to put this together. It worked for
me, although as I am a novice, it's probably a lot bulkier than it needs to
be.

Two things to note: (a) there's a "verification only" line to turn the
range text bright green, so you can make sure it's got the correct text; you
can comment that out when you no longer want it, and (b) you can probably
change the Message Box to a Debug.Print and get your counts listed in the
Immediate window of the VBE.

Hope it works for you.
Ed

Sub Count_Words_On_Page()

Dim rngWork As Range
Dim rngPage As Range
Dim cntPages As Long
Dim PgNo As Long
Dim cntWords As Long
Dim strWord As String
Dim bolDocEnd As Boolean

' What's the word to count?
strWord = InputBox("What word do you want to find?", _
"Word Count")

' Initialize things
bolDocEnd = False
Selection.HomeKey wdStory ' takes you to the start of the document
cntPages = ActiveDocument.BuiltInDocumentProperties(wdPropertyPages)

' ****PAGE LOOP****
Do

' What page are we on?
PgNo = Selection.Information(wdActiveEndPageNumber)

' Initialize range
Set rngWork = Selection.Range

' The page range gets set differently if this is the last page

If PgNo < cntPages Then

' Go to next page
With Selection
.GoTo What:=wdGoToPage, Which:=wdGoToNext

' Move back to end of previous page
.MoveLeft Unit:=wdCharacter, Count:=1
End With

Else: _
ActiveDocument.Bookmarks("\EndOfDoc").Select
bolDocEnd = True

End If

' Extend range to end of page
rngWork.SetRange Start:=rngWork.Start, End:=Selection.End
' **TO VERIFIFY RANGE ONLY**
' **COMMENT OUT WHEN NOT USED**
rngWork.Font.Color = wdColorBrightGreen

' Set ranges
Set rngPage = rngWork.Duplicate

' ****WORD COUNT LOOP****

' Clear counter
cntWords = 0

With rngWork.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = strWord
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = False

' Find all occurrences in the document
Do While .Execute
cntWords = cntWords + 1
rngWork.Collapse wdCollapseEnd
Loop

' **TO VERIFIFY RANGE ONLY**
' **COMMENT OUT WHEN NOT USED**
rngPage.Font.Color = wdColorAutomatic

End With

MsgBox "On page " & PgNo & ", the word " _
& strWord & " was found " & cntWords & " times."

' Repeat until we run out of pages
If bolDocEnd = False Then
' Not at end of document
' Extend range to start of next page
rngPage.MoveEnd Unit:=wdCharacter, Count:=1
' Go to start of next page
rngPage.Collapse wdCollapseEnd
rngPage.Select

Else: Exit Do

End If

Loop

MsgBox "I'm done!"

End Sub

 

[Doug Robbins - Word MVP]

The following will do what you want:

Dim Pages As Long, source As Document, target As Document, resdoc As
Document, restable As Table
Dim i As Long, j As Long, theword As String, pagerange As range
theword = InputBox("Enter the word for which you want count.", "Word Count
by Page")
Set source = ActiveDocument
Selection.HomeKey Unit:=wdStory
Pages = source.BuiltInDocumentProperties(wdPropertyPages)
Set resdoc = Documents.Add
Set restable = resdoc.Tables.Add(range:=resdoc.range, numrows:=Pages + 1,
numcolumns:=2)
restable.Cell(1, 1).range.Text = "Page"
restable.Cell(1, 2).range.Text = "Count"
i = 0
While i < Pages
i = i + 1
source.Activate
Set pagerange = source.Bookmarks("\Page").range
Set target = Documents.Add
target.range = pagerange
j = 0
With target.Content.Find
Do While .Execute(FindText:=theword, Forward:=True,
MatchWholeWord:=True) = True
j = j + 1
Loop
End With
restable.Cell(i + 1, 1).range.Text = i
restable.Cell(i + 1, 2).range.Text = j
target.Close wdDoNotSaveChanges
source.Bookmarks("\Page").range.Cut
Wend
source.Close wdDoNotSaveChanges
resdoc.Activate


--
Please post any further questions or followup to the newsgroups for the
benefit of others who may be interested. Unsolicited questions forwarded
directly to me will only be answered on a paid consulting basis.

Hope this helps
Doug Robbins - Word MVP