wordで変更履歴またはコメントがあるページだけprintするマクロです

'wordで変更履歴またはコメントがあるページだけprintするマクロです
'******************************************************************************
' Function     :  printPagesHavingChangesOrComments
' Description  :  メイン処理
' Parameter    :  なし
' Example      :
' Return Value :　なし
' Author:  kagen88@gmail.com/ 2010/10/10
'******************************************************************************
Sub printPagesHavingChangesOrComments()
Dim pageNum As Integer
Dim pageArray() As Variant

ReDim Preserve pageArray(0)

'ここはポイント、「'文章の先頭から検索を続けますか？」がPOPUPされる
Application.DisplayAlerts = True

'カーソルを最初に移動
Selection.HomeKey Unit:=wdStory

'無限ループにならないように保険
Dim i As Integer
i = 1

'文章の先頭から検索を続けますかに「いいえ」をクリック、エラーを起こす
'ここのエラー実はループの終わり
On Error GoTo finish
Do
   i = i + 1
   '次の変更またはコメントに移動
   WordBasic.NextChangeOrComment
   'その時のページ番号を取得
   pageNum = Selection.Information(wdActiveEndPageNumber)

   'そのページ番号は既にプリント要ページ番号リストに登録していますか
   If Not uInArrayStr(pageNum, pageArray) Then
       ReDim Preserve pageArray(UBound(pageArray) + 1)
       pageArray(UBound(pageArray)) = pageNum
   End If
Loop While i < 500



finish:
   MsgBox "検索完了"
   Dim strPage As String
   Dim sep As String
   sep = ""
   If IsArray(pageArray) Then
       Dim x As Integer
       For x = 1 To UBound(pageArray)
           strPage = strPage & sep & pageArray(x)
           sep = ","
       Next
       res = MsgBox("プリントしますか？", vbOKCancel)
       If res = vbOK Then
               Application.PrintOut FileName:="",
Range:=wdPrintRangeOfPages, Item:= _
           wdPrintDocumentWithMarkup, Copies:=1, Pages:=strPage, PageType:= _
           wdPrintAllPages, ManualDuplexPrint:=False, Collate:=True,
Background:= _
           True, PrintToFile:=False, PrintZoomColumn:=0, PrintZoomRow:=0, _
           PrintZoomPaperWidth:=0, PrintZoomPaperHeight:=0

       End If
   End If

End Sub
'******************************************************************************
' Function     :  uInArrayStr
' Description  :  文字列が配列に入ってるかどうかをチェック
' Parameter    :  文字列、配列
' Example      :
' Return Value :
'                   True:あり
'                   False:なし
' Author:  kagen88@gmail.com/ 2010/10/10
'******************************************************************************
Public Function uInArrayStr(ByVal strTarget As String, ByVal arrArray
As Variant) As Boolean
   Dim blnReturn As Boolean
   Dim intX As Integer
   blnReturn = False

   If IsArray(arrArray) Then
       For intX = 0 To UBound(arrArray)
           If arrArray(intX) = strTarget Then
               blnReturn = True
               Exit For
           End If
       Next
   End If
   uInArrayStr = blnReturn

End Function