Sub PatPresentation()
'
Dim pageSequence As String
pageSequence = ""
'pageSequence = "2,3,4,6,7,19,22,29,8,"
'
' PatPresentation Macro
' Macro created 11/3/2005 by Patrick Donahue
'
    Dim psArray() As String
    psArray = Split(pageSequence, ",")
    Dim ndx As Integer
    Dim curPage As Integer
    Dim lastPage As Integer
    lastPage = ActiveDocument.Content.Information(wdNumberOfPagesInDocument)
    ActiveDocument.PrintPreview ' go into Print Preview mode
    ActiveWindow.ActivePane.View.Zoom.PageFit = wdPageFitFullPage ' use Whole Page Zoom mode
    ActiveWindow.View.FullScreen = True ' go into Full Screen mode
    ActiveDocument.Background.Fill.Visible = False
    ActiveWindow.DisplayVerticalScrollBar = False ' get rid of Vertical Scroll Bar
    CommandBars("Print Preview").Visible = False ' get rid of Print Preview menu line
    CommandBars("Full Screen").Visible = False ' get rid of Full Screen toggle switch
    CommandBars("Control Toolbox").Visible = False ' get rid of Control Toolbox thingy
    CommandBars("Exit Design Mode").Visible = False ' get rid of Exit Design Mode thingy
    System.Cursor = Word.WdCursorType.wdCursorNorthwestArrow ' make cursor an arrow instead of hourglass
    Dim nPut As String
    MsgBox ("Instructions:   type ..." & vbCrLf & vbCrLf & "<Number> then Enter to go to a specified chart" & vbCrLf & "Enter only to go to next page in Sermon sequence" & vbCrLf & "b then Enter to go to previous page in Sermon sequence" & vbCrLf & "u or p then Enter to PageUp" & vbCrLf & "d or n then Enter to PageDown" & vbCrLf & "x or q then Enter to Exit")
    If UBound(psArray) = -1 Then ' no sequence to follow
        nPut = Selection.Information(wdActiveEndPageNumber) ' "1"
    Else
        nPut = psArray(0)
    End If
    Selection.GoTo What:=wdGoToPage, Name:=nPut
    Do While True
        nPut = InputBox("Chart Number ?", "Go To", "", 19000, 19000) ' place InputBox off the screen (hidden)
        If nPut = "exit" Or nPut = "x" Or nPut = "q" Then Exit Do
        If nPut = EscapeKey Or nPut = "f" Then ' forward in sequence (EscapeKey is Return)
            curPage = Selection.Information(wdActiveEndPageNumber)
            'MsgBox "UBound(psArray)=" & UBound(psArray)
            If UBound(psArray) = -1 Then ' no sequence
                Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext
            ElseIf curPage = Int(psArray(UBound(psArray) - 1)) Then
                Selection.GoTo What:=wdGoToPage, Name:=lastPage
            Else
                For ndx = 0 To UBound(psArray) - 1
                  If Int(psArray(ndx)) = curPage Then
                      Selection.GoTo What:=wdGoToPage, Name:=psArray(ndx + 1)
                      Exit For
                  End If
                Next ndx
                If ndx = UBound(psArray) Then Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext
            End If
        ElseIf nPut = "b" Then ' backwards in sequence
            curPage = Selection.Information(wdActiveEndPageNumber)
            'MsgBox "curPage=" & curPage
            'MsgBox "lastPage=" & lastPage
            'MsgBox "UBound(psArray)=" & UBound(psArray)
            If UBound(psArray) = -1 Then ' no sequence
                Selection.GoTo What:=wdGoToPage, Which:=wdGoToPrevious
            ElseIf curPage = lastPage Then
                Selection.GoTo What:=wdGoToPage, Name:=psArray(UBound(psArray) - 1)
            Else
                For ndx = 1 To UBound(psArray) - 1
                   'MsgBox "CurPage=" & curPage & " psArray(ndx)=" & psArray(ndx) & " psArray(ndx+1)=" & psArray(ndx + 1)
                   If Int(psArray(ndx)) = curPage Then
                      Selection.GoTo What:=wdGoToPage, Name:=psArray(ndx - 1)
                      Exit For
                  End If
                Next ndx
                If ndx = UBound(psArray) Then Selection.GoTo What:=wdGoToPage, Which:=wdGoToPrevious
            End If
        ElseIf nPut = "d" Or nPut = "n" Then
            Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext
        ElseIf nPut = "u" Or nPut = "p" Then
            Selection.GoTo What:=wdGoToPage, Which:=wdGoToPrevious
        ElseIf IsNumeric(nPut) Then
            If Int(nPut) < 1 Then nPut = 1
            If Int(nPut) > lastPage Then nPut = lastPage ' to get InsertionPoint mark to disappear - doesn't always work
            Selection.GoTo What:=wdGoToPage, Name:=nPut
        End If
    Loop
    Selection.EscapeKey
    Selection.EscapeKey

End Sub