I think the following code may solve all of my problems (except one
tiny one). There does not seem to be an easy way in VBA to have Word
jump the cursor to a particular section and page number, or a
particular absolute page number. This works by simple going from page
to page.
This will always output the pages for printing in the p1s1 format,
even if it's not necessary. It seemed easier that way.
I've never programmed in VBA before Friday, and so this could be an
awful programme, though ti seems to work on pretty big documents for
me. Thank you for all the great resources, particularly of Word MVP
on the internet, I could never have done it without.
Sub ChangedPages()
'
' Print only Changed Pages Macro
'
'
Dim oRange As Word.Range
Dim intPageCount As Integer
Dim var As Integer
Dim response As Integer
Dim Add, bot, top, fnrevisions As Integer
Dim botstr As String, topstr As String
Dim pagerange As String
Dim Pos As Long, PagesToPrintChunk(10) As String,
PagesForClipboard As String
Dim i As Integer, j As Integer, k As Integer, fn As Integer,
FootNote As Integer
Dim MyData As DataObject
PagesForClipboard = "There are two many pages to be printed in one
go. Please print the following page ranges separately:"
i = 0 ' dummy variable
j = 0 ' dummy variable
Add = 0 'Variable used to determine if pages need to be added
top = -2 ' Variable used to define the top of a page range
bot = -2 ' Variable used to define the bottom of a page range
fnrevsision = 0 'Variable used to determine if any footnotes with
revisions in the document
Application.ScreenUpdating = False ' Prevents the screen from
flashing System.Cursor = wdCursorWait ' Switches the cursor to
egg-timer Selection.EndKey wdStory
If ActiveDocument.Footnotes.Count >= 1 Then fnrevisions =
ActiveDocument.StoryRanges(wdFootnotesStory).Revisions.Count
If ActiveDocument.Range.Revisions.Count + fnrevisions > 0 Then
intPageCount =
ActiveDocument.Range.Information(wdNumberOfPagesInDocument)
Set oRange = ActiveDocument.Range(0, 0)
Set oRange = oRange.GoTo(What:=wdGoToPage, Name:=1)
On Error Resume Next
For var = 1 To intPageCount
Application.StatusBar = "Checking page " & var & " of " &
intPageCount
Set oRange = oRange.GoTo(What:=wdGoToBookmark,
Name:="\page") ' Sets the range to be the page numbered var
For k = 1 To oRange.Footnotes.Count
If oRange.Footnotes(k).Range.Revisions.Count <> 0 Then
GoTo FootNote
End If
Next k
If oRange.Revisions.Count > 0 Then
FootNote:
Add = 1
If var = top + 1 Then
top = var
topstr = "p" &
oRange.Information(wdActiveEndAdjustedPageNumber) _
& "s" &
oRange.Information(wdActiveEndSectionNumber) Else
bot = var
top = var
botstr = "p" &
oRange.Information(wdActiveEndAdjustedPageNumber) _
& "s" &
oRange.Information(wdActiveEndSectionNumber) End If
If var = intPageCount Then
If bot = top Then
pagerange = pagerange & "," & botstr
Else
pagerange = pagerange & "," & botstr & "-" &
topstr End If
End If
Else
If Add = 1 Then
If bot = top Then
pagerange = pagerange & "," & botstr
Else
pagerange = pagerange & "," & botstr & "-" &
topstr End If
Add = 0
End If
End If
Set oRange = oRange.GoToNext(wdGoToPage)
Next
System.Cursor = wdCursorNormal
Application.StatusBar = "Done!"
pagerange = Right(pagerange, Len(pagerange) - 1)
If Len(pagerange) <= 256 Then
With Dialogs(wdDialogFilePrint)
.Pages = pagerange
.Range = wdPrintRangeOfPages
.Show
End With
Else
Do While Len(pagerange) > 256
PagesToPrintChunk(i) = Left$(pagerange, 256)
Pos = InStrRev(PagesToPrintChunk(i), ",")
PagesToPrintChunk(i) = Left$(PagesToPrintChunk(i), Pos
- 1) pagerange = Mid$(pagerange, Pos + 1)
i = i + 1
Loop
PagesToPrintChunk(i) = pagerange
Do While j <= i
var = MsgBox(PagesToPrintChunk(j), vbInformation, "Set
" & j + 1 & " of pages to print")
PagesForClipboard = PagesForClipboard & vbNewLine &
vbNewLine & PagesToPrintChunk(j)
j = j + 1
Loop
Set MyData = New DataObject
MyData.SetText (PagesForClipboard)
response = MsgBox("Copy required pages to clipboard?",
vbYesNo) If response = vbYes Then MyData.PutInClipboard
End If
Else
Select Case ActiveDocument.TrackRevisions
Case False
response = MsgBox("There are no recorded revisions in this
" & _ "document. Track Changes is not enabled. Would " &
_ "you like to turn Track Changes on?", vbYesNo)
If response = vbYes Then ActiveDocument.TrackRevisions =
True Case True
MsgBox "There are no tracked revisions in this document."
End Select
End If
End Sub
The one issue, if anyone wants to look into it, is that a footnote
may span more than one page, and there may be revisions on the second
page of the footnote, which would not be picked up by the above.
Thanks,
John
Graham Mayor said:
I spotted your query yesterday afternoon, just before I packed up
for the day and didn't have time to test my approach to the problem,
and as Doug had answered the question this morning I didn't bother
to contribute; however I think that my approach addresses all your
concerns. The macro looks for any revisions on the page or in the
footnotes and prints just one copy of the page in the order in which
it appears in the document. Any page that has a revision carried
over from the previous page will also print.. It does not matter
whether there are sections in teh document as the macro processes
the current page.
Sub PrintRevisions()
Dim oRng As Range
Dim i, j As Long
Dim iPageCount As Long
Selection.EndKey wdStory
iPageCount = Selection.Information(wdActiveEndPageNumber)
For i = 1 To iPageCount
Selection.GoTo what:=wdGoToPage, name:=i
Set oRng = Selection.Bookmarks("\page").Range
For j = 1 To oRng.Footnotes.Count
If oRng.Footnotes(j).Range.Revisions.Count <> 0 Then
'MsgBox "Revisions in footnotes on page " & i
ActiveDocument.PrintOut Range:=wdPrintCurrentPage
GoTo NextPage
End If
Next j
If oRng.Revisions.Count > 0 Then
'MsgBox "Revisions on page " & i
ActiveDocument.PrintOut Range:=wdPrintCurrentPage
End If
NextPage:
Next i
End Sub
--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
John said:
Doug,
This is incredible helpful, thank you. A few questions:
1) If I understand correctly, this will list all the pages with
changes in the main text, and then all the pages with changes in the
footnotes, so the pages will print out of order. This isn't ideal.
2) If a revision splits across more than one page (i.e., starts on
page 2, goes to page 3), I think this will only print page 3?
3) If a document has multiple sections (and pages that restart
numbering in each section), I think the code will not quite return
the pages that word needs to print - i.e., I guess it needs to
return something like s1p1,s3p1, unles theres a way of making word
print absolute page numbers?)
4) In a long document, there can easily be more than 100 pages with
changes, and if the string is more than 256 characters, word can't
print. I found something on the MVP site to handle this I think,
along the lines of:
If Len(revpages) <= 256 Then
With Dialogs(wdDialogFilePrint)
.Pages = revpages
.Range = wdPrintRangeOfPages
.Show
End With
Else
Do While Len(revpages) > 256
PagesToPrintChunk(k) = Left$(revpages, 256)
Pos = InStrRev(PagesToPrintChunk(k), ",")
PagesToPrintChunk(k) = Left$(PagesToPrintChunk(k),
Pos - 1) revpages = Mid$(revpages, Pos + 1)
k = k + 1
Loop
PagesToPrintChunk(k) = revpages
which makes an array of pages needing printing. I also came up with
some
code that builds the revpages array to include -s if multiple pages
next to each other need printing, which shorten it somewhat.
5) In a document that has 1000s of revisions, might it be better to
use my mehtod of going from page to page and seeing if there is 0 or
more than 0 revisioins, and deciding if to print that page? Then the
loop would be limited to the number of pages, not checking which
page each revision is on? That's why, if it's possible to somehow
set the range to be the footnotes of the page the rnage is on, if
there are any, I think it might be a little quicker.
Any advice on the above points wouild be much appreciated on the
above points.
Thanks!
John
:
The following code will print out the pages on which there are
revisions, whether they are in the main body of the document or the
footnotes:
Dim pnum As Long
Dim i As Long
Dim j As Long
Dim flag As Boolean
Dim arev As Revision
Dim revpages As String
Dim revarray As Variant
revpages = ""
pnum = 0
Dim astory As Range
For Each astory In ActiveDocument.StoryRanges
For Each arev In astory.Revisions
i = arev.Range.Information(wdActiveEndPageNumber)
If i <> pnum Then
pnum = i
If Not IsEmpty(revarray) Then
flag = False
For j = 0 To UBound(revarray)
If i = revarray(j) Then
flag = True
End If
Next j
If flag = False Then
revpages = revpages & "," & i
End If
Else
revpages = revpages & i
End If
revarray = Split(revpages, ",")
End If
Next arev
Next astory
ActiveDocument.PrintOut Range:=wdPrintRangeOfPages, Pages:=revpages
--
Hope this helps.
Please reply to the newsgroup unless you wish to avail yourself of
my services on a paid consulting basis.
Doug Robbins - Word MVP, originally posted via msnews.microsoft.com
Hello,
I am new to VBA programming - thank you for your help in advance.
I would like to set a Range to be the footnotes on a given page.
For example, in this loop:
For var = 1 To intPageCount
Set oRange = ActiveDocument.Range(0, 0)
Set oRange = oRange.GoTo(What:=wdGoToPage, Name:=var)
Set oRange = oRange.GoTo(What:=wdGoToBookmark,
Name:="\page") If oRange.Revisions.Count > 0 Then
[print page]
oRange cycles through each page. The purpose of this is that I can
then see
if there are any revisions on a given page, and if there are,
print the page
(hence the macro only prints pages with revisions on).
However, sometimes there are revisiosn in a footnote on a page,
and no revisions in the text on that page, and that page wouldn't
be printed. So effectively, I need to be able to set the range to
be the footnote text on a
given page, if there is any.
Any advise would be much appreciate
