Tuesday, September 11, 2007

UPDATED - Video Prompter Macro Script for Word

NOTE: Someone sent a message asking "where does the macro go?"
In Microsoft Word 2003, go into TOOLS > MACROS > MACRO > EDIT (an existing macro) and then paste in the script to the new "computer coding" window that appears. Then do a FILE > SAVE on that window and close.

To run the script, you go back into TOOLS > MACROS > MACRO > (name of your macro) > RUN.

For more information, consult Microsoft's tutorial for Word 2003 at:
http://office.microsoft.com/en-us/word/HP051894201033.aspx





Here is the updated script I have for Word that serves as a Video Prompter.

The features now include:

  • Choose the scroll speed
  • Choose the font size
  • Automatically change to screen-width document display
  • Automatically change to white font on black background


Sub DownBit()
' Created by James Falkofske

Dim PauseTime, Start, Finish, TotalTime
Dim i, iMax As Integer
Dim i1, i2, i3, i4 As String
Dim fTiming, fFontSize As Double

i1 = InputBox("Enter number of Lines to Move", _
"Teleprompter Motion", 100)
iMax = CInt(i1)

i2 = InputBox("Enter Delay seconds between moves", _
"Movement Timing", 0.35)
fTiming = CDbl(i2)

i3 = InputBox("Enter the font size in points", "Font Size", 32)
fFontSize = CDbl(i3)

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

No comments: