Comments on: word count on page

Question: word count on page

reklaw — Wed, 03 Aug 2005 07:08:36 -0800

So I'm trying to write a Word macro to count how many words there are on the current page of the document. It's not going well.

It's already taken me quite a while to figure out that the code to get the current page number is Selection.Information(wdActiveEndPageNumber) -- I mean, how intuitive is that? From there it seems that I'd need to use Selection.MoveUp and Selection.MoveDown in a loop and make it stop and reverse when it finds page breaks, but I'm at a loss as to how to do it.

By: oddman

oddman — Wed, 03 Aug 2005 07:19:46 -0800

Why not just use the mouse (or shift-arrow keys) to select the words on the page and use the regular count tool. It automatically restricts itself to the selected text. (Well it does in my version of Word (2002))?

Maybe I'm missing something.

By: reklaw

reklaw — Wed, 03 Aug 2005 08:30:34 -0800

Well yeah, that'd be fine if there was any shortcut key that meant 'Select All on Page' (using Shift+PgUp/PgDn doesn't seem to respect page breaks at all). As far as I can tell, there's everything else, but no Select All on Page. A macro for that function would be just as good.

By: boo_radley

boo_radley — Wed, 03 Aug 2005 08:41:56 -0800

Cribbed from various sources. No warranties, express or implied, released into the public domain, etc, etc.
Does not give wordcount for the very last page. This is left as an excercise for the reader.

Sub getPageWordCount()

Dim iPgNum As Integer
Dim sPgNum As String
Dim ascChar As Integer
Dim rngPage As Range
Dim iBeginPage As Integer
Dim iEndPage As Integer
' Go to start of document and make sure its paginated correctly.
Selection.HomeKey Unit:=wdStory, Extend:=wdMove
ActiveDocument.Repaginate

' Loop through the number of pages in the document.
For iPgNum = 2 To Selection.Information(wdNumberOfPagesInDocument)
sPgNum = CStr(iPgNum)
iBeginPage = Selection.start
' Go to next page
Selection.GoTo wdGoToPage, wdGoToAbsolute, sPgNum
' and to the last character of the previous page...
Selection.MoveLeft wdCharacter, 1, wdMove
iEndPage = Selection.start
' Retrieve the character code at insertion point.
Set rngPage = ActiveDocument.Range(iBeginPage, iEndPage)
MsgBox rngPage.ComputeStatistics(wdStatisticWords)
' Check the character code for hard page break or text.
Next

End Sub

By: reklaw

reklaw — Wed, 03 Aug 2005 09:10:29 -0800

Well, that solution didn't quite work right (it looped through each page instead of just counting the current page). It did show me how the GoTo function worked, though, which let me figure out that this modified version would work:

Sub getPageWordCount()

Dim rngPage As Range
Dim iBeginSel As Integer
Dim iEndSel As Integer
Dim iCurrentPage As Integer
Dim iNextPage As Integer

iCurrentPage = Selection.Information(wdActiveEndPageNumber)
Selection.GoTo wdGoToPage, wdGoToAbsolute, iCurrentPage
iBeginSel = Selection.Start

iNextPage = iCurrentPage + 1
Selection.GoTo wdGoToPage, wdGoToAbsolute, iNextPage
Selection.MoveLeft wdCharacter, 1, wdMove
iEndSel = Selection.Start

Set rngPage = ActiveDocument.Range(iBeginSel, iEndSel)
MsgBox rngPage.ComputeStatistics(wdStatisticWords) & " words.", vbOKOnly, "Word Count for Page"

End Sub

Thanks for your help.

By: whatisish

whatisish — Wed, 03 Aug 2005 09:50:22 -0800

FYI - that modified source appears to generated an error if you are currently on the last page.

By: Capn

Capn — Wed, 03 Aug 2005 11:10:54 -0800

Are you sure you want to know the exact number of words? (second last paragraph).

By: whatisish

whatisish — Wed, 03 Aug 2005 14:00:46 -0800

Borrowing from those before me... this works (terribly sloppy, I know - I really dont know what I'm doing here) and doesn't generate an error on the last page. It also assumes that no page can have more than 2000 characters.

Sub CountWordsonPage()

Dim rngPage As Range
Dim iBeginSel As Integer
Dim iEndSel As Integer
Dim iCurrentPage As Integer
Dim iNextPage As Integer

' Mark the beginning of current page
iCurrentPage = Selection.Information(wdActiveEndPageNumber)
Selection.GoTo wdGoToPage, wdGoToAbsolute, iCurrentPage
iBeginSel = Selection.Start

' Mark the end of current page
Do Until iCurrentPage <> Selection.Information(wdActiveEndPageNumber) Or x = 2000
Selection.MoveRight wdCharacter, 1, wdMove
x = x + 1
Loop
iEndSel = Selection.Start

' Count Words
Set rngPage = ActiveDocument.Range(iBeginSel, iEndSel)
MsgBox rngPage.ComputeStatistics(wdStatisticWords) & " words.", vbOKOnly, "Word Count for Page"

' Puts cursor back at the top of the original page.
' What would be nice is to mark the original cursor
' location and return it to that location instead.
If iCurrentPage = Selection.Information(wdActiveEndPageNumber) Then
Selection.GoTo wdGoToPage, wdGoToAbsolute, iCurrentPage
Else
Selection.GoTo wdGoToPage, wdGoToAbsolute, iCurrentPage - 1
End If

End Sub