Sub PatPresentation() ' Dim pageSequence As String pageSequence = "" ' OSAS - pageSequence = "11,13,14,15,18,22,31,32,25,9,17,5,10,19,27,6,30,16,26," ' SubstitutionaryDeath - pageSequence = "45,51,52,47,48,53,54,60,61,58,63,9,17,112,111,19,20,21,22,46,117," ' ' 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.ActivePane.View.Zoom.PageFit = wdPageFitBestFit ' bleeds past bottom of page 'ActiveWindow.ActivePane.View.Zoom.PageFit = wdPageFitTextFit ' bleeds past bottom of page 'ActiveWindow.ActivePane.View.Zoom.Percentage = 100 ' new 'ActiveWindow.ActivePane.View.Type = wdPageView 'ActiveWindow.ActivePane.View.Zoom.PageFit = 2 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 & " 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 = lastPage ' "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 ' if doesn't work on Carol's computer, that is because ' www.BibleDebates.info is displayed as hyperlink on Carol's computer spilling over onto the next page; ' make it not a hyperlink Selection.GoTo What:=wdGoToPage, Name:=nPut End If Loop Selection.EscapeKey Selection.EscapeKey End Sub