Existing macro needs modification for desired result

[pnutty1]

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

[gmayor]

Text boxes are in the graphics layer of the document so are not seen by the code when processing the document range. You would also have to loop through the shapes in your document and process those shapes that are text boxes e.g.

Dim oShape As Shape
For Each oShape In ActiveDocument.Shapes
If oShape.Type = 17 Then 'msoTextBox
oShape.Select
MsgBox Selection.Range.Revisions.Count
End If
Next