Updated Teleprompter Script

Updated Teleprompter Script for Word 2007

Here is an updated macro script for Microsoft Word 2007. This turns your script into a WHITE text on black background, auto-scrolled text.

Remember that you can continue to use your MOUSE's SCROLL WHEEL while this macro is running - in case the script gets ahead of your (or behind you).

Sub VideoPrompter()
'
' VideoPrompter Macro
' Macro created 8/13/2007 by James Falkofske
'
' Autoscroll Window
Dim PauseTime, Start, Finish, TotalTime
Dim i, iMax As Integer
Dim i1, i2, i3, i4 As String
Dim fTiming, fFontSize As Double

'How big should the text be?
i3 = InputBox("Enter the Font size in points", _
  "Font Size", 32)
fFontSize = CDbl(i3)

'How many lines of movement are needed?
i1 = InputBox("Enter scroll-down-clicks for script", _
"Teleprompter Motion", 1000)
iMax = CInt(i1)

'How much of a pause between each movement of script
i2 = InputBox("Enter the delay moves (decimal seconds)", _
"Movement Timing", 0.35)
fTiming = CDbl(i2)



 With Selection.PageSetup
     .LineNumbering.Active = False
     .Orientation = wdOrientPortrait
     .TopMargin = InchesToPoints(0.5)
     .BottomMargin = InchesToPoints(0.5)
     .LeftMargin = InchesToPoints(0.5)
     .RightMargin = InchesToPoints(0.5)
     .Gutter = InchesToPoints(0)
     .HeaderDistance = InchesToPoints(0.5)
     .FooterDistance = InchesToPoints(0.5)
     .PageWidth = InchesToPoints(8.5)
     .PageHeight = InchesToPoints(11)
     .VerticalAlignment = wdAlignVerticalTop
     .TwoPagesOnOne = False
 End With

 ActiveDocument.Background.Fill.ForeColor.ObjectThemeColor = _
     wdThemeColorText1
 ActiveDocument.Background.Fill.ForeColor.TintAndShade = 0#
 ActiveDocument.Background.Fill.Visible = msoTrue
 ActiveDocument.Background.Fill.Solid

 Selection.WholeStory
 Selection.Font.Size = fFontSize
 Selection.HomeKey Unit:=wdStory
 ActiveWindow.ActivePane.View.Zoom.PageFit = wdPageFitBestFit

For i = 1 To iMax
    PauseTime = fTiming        ' Set duration.
    Start = Timer    ' Set start time.
    Do While Timer < Start + PauseTime
        DoEvents    ' Yield to other processes.
        
    Loop
   'Move down a small scroll increment
   ActiveWindow.ActivePane.SmallScroll Down:=1
Next i

End Sub