We have a macro created to detect Tracked Change pages and a 2nd call macro that detects comments, PDFs are created for each of the pages. It works well with the exception that it will not detect track change pages in a text box. The code is below, anybody have any suggestions? (my very first post so apologies if I did this wrong).
Sub PrintRevisionPagesOnly()
' Print only pages with recorded revisions
' keyboard shortcut = Alt-P
' NOTE: if Track Changes is not enabled there ARE
' no recorded revisions. If Track Changes not enabled
' the code offers to enable it.
Dim oRange As Word.Range
Dim intPageCount As Integer
Dim var
Dim response
Dim sFileName
Dim sFilePath
Dim sFolderPath
Dim sAppName
Dim sArg
sAppName = "C:\PDFMerge\PDF_Merge.exe "
sFolderPath = "C:\DataTest"
sFileName = ActiveDocument.Name
sFilePath = sFolderPath
sFileName = Left(sFileName, (InStrRev(sFileName, ".", -1, vbTextCompare) - 1))
sArg = """" & sFolderPath & """" & " " & """" & sFileName & "_Revision.pdf" & """"
ActiveWindow.View.RevisionsFilter.Markup = wdRevisionsMarkupAll
If ActiveDocument.Range.Revisions.Count > 0 Then
intPageCount = _
ActiveDocument.BuiltInDocumentProperties("Number of Pages")
'ActiveDocument.Range.Information (wdNumberOfPagesInDocument)
Selection.HomeKey Unit:=wdStory
On Error Resume Next
ActiveDocument.PrintRevisions = True
For var = 1 To intPageCount
Set oRange = _
ActiveDocument.Range _
(Start:=ActiveDocument.Bookmarks("\page").Start, _
End:=ActiveDocument.Bookmarks("\page").End - 1)
If (oRange.Revisions.Count > 0) Then
sFilePath = sFolderPath
sFilePath = sFilePath + CStr(var) + ".pdf"
Selection.ExportAsFixedFormat sFilePath, wdExportFormatPDF, _
False, wdExportOptimizeForPrint, True, wdExportDocumentWithMarkup, True, True, wdExportCreateNoBookmarks, _
True, True, False
DoEvents
Selection.GoToNext wdGoToPage
Else
Selection.GoToNext wdGoToPage
End If
Set oRange = Nothing
Next
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
Call FindComment(sFolderPath)
Call Shell(sAppName, vbNormalFocus)
End Sub
Sub FindComment(ByVal FolderPath As String)
'
' FindComments Macro
'
'
Dim oRange As Word.Range
Dim intPageCount As Integer
Dim var
Dim response
Dim sFileName
Dim sFilePath
If ActiveDocument.Range.Revisions.Count > 0 Then
intPageCount = _
ActiveDocument.BuiltInDocumentProperties("Number of Pages")
'ActiveDocument.Range.Information (wdNumberOfPagesInDocument)
Selection.HomeKey Unit:=wdStory
On Error Resume Next
ActiveDocument.PrintRevisions = True
For var = 1 To intPageCount
Set oRange = _
ActiveDocument.Range _
(Start:=ActiveDocument.Bookmarks("\page").Start, _
End:=ActiveDocument.Bookmarks("\page").End - 1)
If (oRange.Comments.Count > 0) Then
sFilePath = FolderPath
sFilePath = sFilePath + CStr(var) + ".pdf"
Selection.ExportAsFixedFormat sFilePath, wdExportFormatPDF, _
False, wdExportOptimizeForPrint, True, wdExportDocumentWithMarkup, True, True, wdExportCreateNoBookmarks, _
True, True, False
DoEvents
Selection.GoToNext wdGoToPage
Else
Selection.GoToNext wdGoToPage
End If
Set oRange = Nothing
Next
End If
End Sub