Visio Slide Show
(updated 6/11/09 – added support for a dialog to allow you to set the interval between slides)
Recently I was asked if it was possible to set a timer to automatically switch to the next page when in full screen mode, producing a slide show style presentation mode.
I decided to do this using VBA as this code can easily be added to any Visio document that needs this functionality.
FYI, when the slide show macro is running and the last page in the document is reached, the slide show will continue with the first page via a continuous loop.
To add this functionality to your document:
Open your document
Open the Visual Basic editor, ALT + F11 or from the Tools > Macro > Visual Basic Editor menu item
Paste the code below into the ThisDocument module via the Visual Basic editor
By default the editor opens the ThisDocument module.
Start the slide show
From the Tools > Macros > ThisDocument menu select StartSlideShow
Stop the slide show
Simply press the ESC key. This will exit full screen mode and also trigger the timer in the macro to stop, returning you to the Visio application window.
Set the Interval
From the Tools >Macros > ThisDocument menu select SetInterval
Download the Visio diagram that contains this code here.
Here is the VBA code:
Option Explicit
Private WithEvents g_vsoApplication As Visio.Application
Private g_interval As Integer
Private Const DEFAULT_INTERVAL As Integer = 5
Private g_fullScreen As Boolean
Public Sub SetInterval()
Dim entryVal As String
Dim entryError As Boolean
reEnterValue:
' init our error flag
entryError = False
' determine if we show the default value or the last entered value
Dim initVal As Integer
If Not (g_interval = DEFAULT_INTERVAL) And Not (g_interval = 0) Then
initVal = g_interval
Else
initVal = DEFAULT_INTERVAL
End If
' get a new value from the user
entryVal = InputBox("Enter the interval (in seconds 1 - 60)", "Set Slide Show interval", initVal)
If Len(entryVal) = 0 Then
' the user pressed cancel
Exit Sub
End If
Dim tmpInterval As Integer
If IsNumeric(entryVal) Then
tmpInterval = Conversion.CInt(entryVal)
If tmpInterval < 1 Or tmpInterval > 60 Then
entryError = True
End If
Else
entryError = True
End If
If entryError Then
MsgBox "Please enter a value between 1 - 60"
GoTo reEnterValue
End If
g_interval = tmpInterval
End Sub
Public Sub StartSlideShow()
Set g_vsoApplication = Application
Dim iNextPage As Integer
iNextPage = 1
' set the first page
ActiveWindow.Page = ThisDocument.Pages(iNextPage)
' enter full screen mode
Application.DoCmd visCmdFullScreenMode
g_fullScreen = True
Do While g_fullScreen
' start timer
Dim pTime, pStart, pEnd, tTime, lTime
'five second loop
pTime = g_interval
pStart = Timer
Do While (Timer < pStart + pTime) And g_fullScreen = True
DoEvents
lTime = (pStart + pTime) - Timer
Loop
' get the next page index that we need to switch to
If iNextPage = ThisDocument.Pages.Count Then
iNextPage = 0
End If
iNextPage = iNextPage + 1
' get the next page and switch to it
Dim vsoNextPage As Visio.Page
Set vsoNextPage = ThisDocument.Pages(iNextPage)
ActiveWindow.Page = vsoNextPage
' reset timer
pEnd = Timer
tTime = pEnd - pStart
Loop
End Sub
Private Sub g_vsoApplication_KeyPress(ByVal KeyAscii As Long, CancelDefault As Boolean)
' kill the code on any keypress
g_fullScreen = False
End Sub