In my innocence, I thought it would be as easy as preparing some content and then declaming it with confidence. Well, it took me some time to get the thing done without ever appearing stuck on the next sentence.
Do not fail where I did!. Having excruciated in my flesh that I do not have the gift of public speaking, I have decided to find a solution for the next occasion. In the non-amateur world this is solved with a teleprompter / autocue… although I was not in the business of buying one for the occasion or getting into the DIY world.
The online webapps didn’t seem very helpful in first run. And even if you can also get it done with a mobile application, tests were not good: still looks as you staring not to the camera, apps are full of ads… and I have been scared by the size of the videos recorded with the phone.
My best alternative lies on using the laptop’s webcam. There are some apps/browser extensions that can reach it. Placing the text to be displayed just below the point of the lens will get it done.
With the following code you can get a “very basic” Excel based teleprompter.
Sub AutoCueV1()
Dim dtScreencastNext As Date
dtScreencastNext = VBA.Now() + VBA.TimeSerial(0, 0, 1)
Do
If VBA.Now() > dtScreencastNext Then
ActiveWindow.SmallScroll Down:=1
dtScreencastNext = VBA.Now() + VBA.TimeSerial(0, 0, 1)
End If
DoEvents
Loop
End Sub
The scrolling of the screen is jerky, and as we still have to solve the mirror issue it’s only usable as a poor man teleprompter, but with no use of glass, and no black shelling of light… just need a webcam and pour some text on Excel.
To mimic the mirror effect and get a nice scrolling behaviour, we can use shapes that scroll over the screen. In order to do so, insert a shape, and to fill it with the text of a cell into the shape, type =[cellAddress] in the formula bar and press Enter. Take care, you are only allowed to point to one cell address, and do not make use of any formulas or chars, if needed apply inside the cell formula.
I have named this shape as “oShp”, and will be replicated to handle the rest of the text lines. Tune the format of this shape until you get the desired looking, but the better is black background, and text in white-grey color.
To mirror the content, select the Drawing-Format tab, click ‘Text Effects’, move down to ‘3-D rotation’ options (at the bottom of the menu), and set 180° in the X axis for a horizontal rotation (as if the mirror is to the right or left) and in the Y axis for a vertical rotation (as if the mirror is above or below).
In order to start/stop control, use another shape to trigger all, with .onAction property set to
sPrompterControlprocedurePublic bRun As Boolean
Public Sub sPrompterControl()
bRun = Not bRun
If bRun Then Call AutoCueV2
End Sub
Private Sub AutoCueV2()
Dim bMirror As Boolean: bMirror = True
Dim NumberOfTextLines As Long: NumberOfTextLines = 10
Dim VerticalSpeed As Single: VerticalSpeed = 10
Dim TimeStep As Single: TimeStep = 0.005
Dim xInc As Single, yInc As Single
'---------------------------------------------------------
Dim TextRow As Long
Dim oShp As Excel.Shape
Dim oShp2 As Excel.Shape
Dim oShpRng As Excel.ShapeRange
Dim i As Long
Set oShp = ActiveSheet.Shapes.Item("oShp")
With oShp
'.Formula = "=$A$" & ...
.Placement = xlFreeFloating
.Locked = msoFalse
.Select
Selection.ShapeRange.TextFrame2.ThreeD.RotationX = VBA.IIf(bMirror, -180, 0)
Selection.PrintObject = msoFalse
End With
' Duplicate shapes...
TextRow = 0
For i = 1 To NumberOfTextLines
With oShp
Set oShp2 = .Duplicate
oShp2.Left = .Left
oShp2.Top = oShp.Top + (oShp.Height * i)
End With
With oShp2
TextRow = TextRow + 1
.Name = "oShp_Tmp_" & VBA.Format(i, "00")
.DrawingObject.Formula = "=$A$" & TextRow
End With
Next i
' Scroll text
Dim dtScreencastNext As Date
yInc = oShp.Height / 100 'VerticalSpeed / 10000
Do
'Do While Timer < Start + TimeStep: DoEvents: Loop
For i = 1 To NumberOfTextLines
Set oShp2 = ActiveSheet.Shapes.Item("oShp_Tmp_" & VBA.Format(i, "00"))
With oShp2
If .Top + -yInc < 0 Then
.Top = .Height * NumberOfTextLines
TextRow = TextRow + 1
.DrawingObject.Formula = "=$A$" & TextRow
End If
'.IncrementLeft xInc
.IncrementTop -yInc
'.Top = .Top - VerticalSpeed / 10000
Start = Timer
End With
Next i
DoEvents
Loop While bRun
' Delete shapes, clean worksheet
For i = ActiveSheet.Shapes.Count To 1 Step -1
If ActiveSheet.Shapes.Item(i).Name Like "oShp_Tmp_#*" Then
ActiveSheet.Shapes.Item(i).Delete
End If
Next i
End Sub
You can set
NumberOfTextLines, TimeStep and VerticalSpeed to fit your needings, and can use with the mirrowed effect or not via bMirror variable.In both cases (the first or the second version), there is one more thing that shoud be done, that is to get everything the closer to the webcam lens as possible. To achieve this you’ll need to collapse the ribbon and the formula bar, but if you do not want to mess this “kiosk mode” with your Excel Windows, better open a new instance of Excel to run this teleprompter thing. Use following code, that can be also triggered via
Workbook_Openand with Workbook_BeforeClose:
Private Sub AutoCue()
Dim oXlApp As Excel.Application
Dim oXlWbk As Excel.Workbook
Dim fDialog As FileDialog, result As Integer
Dim filePath As String
Dim fileName As String
Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
' Optional: FileDialog properties
fDialog.AllowMultiSelect = False
fDialog.Title = "Select autocue file"
fDialog.InitialFileName = VBA.Environ$("HomeDrive") & "\"
' Optional: Add filters
fDialog.Filters.Clear
fDialog.Filters.Add "Excel macro files", "*.xlsm"
'fDialog.Filters.Add "All files", "*.*"
'Show the dialog. -1 means success!
If fDialog.Show = -1 Then
filePath = fDialog.SelectedItems(1)
fileName = Right(filePath, VBA.Len(filePath) - VBA.InStrRev(filePath, "\"))
Set oXlApp = Excel.Application
Set oXlWbk = oXlApp.Workbooks.Open(filePath)
oXlApp.Visible = True
AppActivate fileName ' Brings it to Front & gives it the Focus
If oXlApp.Workbooks.Count = 1 Then
oXlApp.Quit
Else
oXlWbk.Close False
Set oXlApp = Nothing
Set oXlWbk = Nothing
End If
End If
End Sub
'Private Sub Workbook_Open()
' Call UIHide
'End Sub
'Private Sub Workbook_Activate()
' Call UIHide
'End Sub
'Private Sub Workbook_BeforeClose(Cancel As Boolean)
' Call UIRestore
'End Sub
'Private Sub Workbook_Deactivate()
' Call UIRestore
'End Sub
Public Sub UIHide()
' code to hide UI to get kiosk mode:
With Application
OldScreenUpdating = .ScreenUpdating
OldCalculation = .Calculation
OldWindowState = .WindowState
.ScreenUpdating = False
.Calculation = xlCalculationManual
.WindowState = xlNormal
OldRibbonShow = (Application.CommandBars("Ribbon").Height > 100)
.ExecuteExcel4Macro "Show.Toolbar(""Ribbon"",False)"
OldFullScreen = .CommandBars("Full Screen").Visible
OldMenuBar = .CommandBars("Worksheet Menu Bar").Enabled
.CommandBars("Full Screen").Visible = False
.CommandBars("Worksheet Menu Bar").Enabled = False
OldDisplayStatusBar = .DisplayStatusBar
OldDisplayScrollBars = .DisplayScrollBars
OldDisplayFormulaBar = .DisplayFormulaBar
.DisplayStatusBar = False
.DisplayScrollBars = False
.DisplayFormulaBar = False
OldWidth = .Width
OldHeight = .Height
.Width = 800
.Height = 450
OldTop = .Top
OldLeft = .Left
.Top = -100
.Left = 0
End With
With ActiveWindow
OldDisplayWorkbookTabs = .DisplayWorkbookTabs
OldDisplayHeadings = .DisplayHeadings
OldDisplayRuler = .DisplayRuler
OldDisplayFormulas = .DisplayFormulas
OldDisplayGridlines = .DisplayGridlines
OldDisplayHorizontalScrollBar = .DisplayHorizontalScrollBar
OldDisplayVerticalScrollBar = .DisplayVerticalScrollBar
' .DisplayWorkbookTabs = False
.DisplayHeadings = False
' .DisplayRuler = False
' .DisplayFormulas = False
' .DisplayGridlines = False
' .DisplayHorizontalScrollBar = False
' .DisplayVerticalScrollBar = True
End With
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
End Sub
Public Sub UIRestore()
' code to reset everything back displayed:
With Application
.ExecuteExcel4Macro "Show.Toolbar(""Ribbon""," & VBA.IIf(OldRibbonShow, "True", "False") & ")"
.CommandBars("Full Screen").Visible = OldFullScreen
.CommandBars("Worksheet Menu Bar").Enabled = OldMenuBar
.DisplayStatusBar = OldDisplayStatusBar
.DisplayScrollBars = OldDisplayScrollBars
.DisplayFormulaBar = OldDisplayFormulaBar
.Top = OldTop
.Left = OldLeft
.Width = OldWidth
.Height = OldHeight
End With
With ActiveWindow
' .DisplayWorkbookTabs = OldDisplayWorkbookTabs
.DisplayHeadings = OldDisplayHeadings
' .DisplayRuler = OldDisplayRuler
' .DisplayFormulas = OldDisplayFormulas
' .DisplayGridlines = OldDisplayGridlines
' .DisplayHorizontalScrollBar = OldDisplayHorizontalScrollBar
' .DisplayVerticalScrollBar = OldDisplayVerticalScrollBar
End With
With Application
.ScreenUpdating = OldScreenUpdating
.Calculation = OldCalculation
.WindowState = OldWindowState
End With
End SubbYou can set the top window position to be negative, so you can also have the UserForm title bar out of sight. OnStore previous values of window configuration to restore from variables:
Private OldScreenUpdating As Boolean
Private OldCalculation As Long
Private OldWindowState As Long
Private OldRibbonShow As Boolean
Private OldFullScreen As Boolean
Private OldMenuBar As Boolean
Private OldDisplayStatusBar As Boolean
Private OldDisplayScrollBars As Boolean
Private OldDisplayFormulaBar As Boolean
Private OldWidth As Single
Private OldHeight As Single
Private OldTop As Single
Private OldLeft As Single
Private OldDisplayWorkbookTabs As Boolean
Private OldDisplayHeadings As Boolean
Private OldDisplayRuler As Boolean
Private OldDisplayFormulas As Boolean
Private OldDisplayGridlines As Boolean
Private OldDisplayHorizontalScrollBar As Boolean
Private OldDisplayVerticalScrollBar As Boolean