Adding Features to PowerPoint Based Oracle Presentation Files

April 28, 2011

This blog article is not specific to Oracle Database, but I thought that I would share the concepts anyway.  If you are giving presentations and using PowerPoint, consider including detailed notes sections in the presentation.  What benefit do those notes sections serve?  Well, if you share the presentation files with the viewers of the presentation, those note sections act as a reminder of what was stated during your presentation.  In fact, you could go so far as to type everything that you intend to say during the presentation into the presentation notes section for the slides.

Let’s take a look at a couple of interesting features that can be implemented in a PowerPoint presentation when detailed notes sections are provided.

Read to Me:

In 1998 (or maybe it was 1999) I experimented with the Microsoft Speech API, which at that time was still in Beta form for the initial release.  More recent releases of the Microsoft Speech API are obviously much more sophisticated, but at the time it was possible to easily change between one of several “voices” with different pitch and speed settings.  It is very easy to incorporate speech capabilities into a PowerPoint presentation, because the Speech API is installed by default on computers running Microsoft Office (I believe that the Speech API is also included in Windows operating systems starting with Microsoft Vista).  A very simple, generic PowerPoint macro may be used to read back the notes section of the currently displayed slide:

Sub SpeakNotes()
    Const SVSFlagsAsync = 1
    Const SVSFPurgeBeforeSpeak = 2
    'Dim strText As String
    Dim strSpeech As String
    Dim objSpeech As Object
    Dim lngCurrentSlide As Long

    On Error Resume Next

    Set objSpeech = CreateObject("SAPI.SpVoice")

    lngCurrentSlide = SlideShowWindows(1).View.CurrentShowPosition

    If Application.Version <= "11.0" Then
        strSpeech = ActivePresentation.Slides(lngCurrentSlide).NotesPage.Shapes.Placeholders(2).TextFrame.TextRange.Text
        'Change the pitch
        'strSpeech = "<pitch middle='25'>" & ActivePresentation.Slides(lngCurrentSlide).NotesPage.Shapes.Placeholders(2).TextFrame.TextRange.Text
    Else
        strSpeech = ActivePresentation.Slides(lngCurrentSlide).NotesPage.Shapes.Placeholders(2).TextFrame.TextRange.Text
    End If

    objSpeech.Speak strSpeech

    Set objSpeech = Nothing
End Sub

In the above you will notice that the macro code checks the version of PowerPoint so that it can potentially run a different set of control commands for the speech API (I do not recall the exact reason why I included this years ago, but I believe it is because the default voice in Microsoft Office 2003 is a male voice, while the default voice in Microsoft Office 2007 is a female voice).  Now all that needs to be done is to create a picture or object of some sort on a slide and associate an action with the object that executes the above macro.  I have used a couple of different objects over the years, typically designed to clearly communicate what will happen when the object is clicked, for example:

—

Write to Me:

Another interesting feature that may be implemented is exporting the slides to JPG pictures, and then building a Microsoft Word Document from the exported JPG pictures and the slide notes – this is helpful for both the presenter and the people learning from the presentation.  In the past I had to manually create these types of handouts, so I thought “why not automate the process?”

We will start with the code to generate the JPG pictures from the presentation slides:

 
Sub WriteSlidestoJPG()
    On Error Resume Next

    'Create a folder for the slides if one does not already exist
    If Len(Dir("C:\Presentation Slides", vbDirectory)) < 4 Then
        MkDir "C:\Presentation Slides"
    End If

    'Remove any slides from a previous execution
    Kill "C:\Presentation Slides\*.*"
    'Save the slides as JPG pictures
    ActivePresentation.Export "C:\Presentation Slides", "JPG", 640, 480  '640 pixels by 480 pixels
End Sub

Next, we will add a second macro that builds the Microsoft Word document:

Sub SendPowerPointSlidestoWord()
    Dim i As Integer
    Dim objWord As Word.Application

    On Error Resume Next

    Set objWord = New Word.Application

    If Err = 0 Then
        WriteSlidestoJPG

        With objWord
            .Documents.Add
            .Visible = True
            With .ActiveDocument.Styles(wdStyleNormal).Font
                If .NameFarEast = .NameAscii Then
                    .NameAscii = ""
                End If
                .NameFarEast = ""
            End With
            With .ActiveDocument.PageSetup
                .TopMargin = InchesToPoints(0.5)
                .BottomMargin = InchesToPoints(0.5)
                .LeftMargin = InchesToPoints(0.75)
                .RightMargin = InchesToPoints(0.25)
                .HeaderDistance = InchesToPoints(0.25)
                .FooterDistance = InchesToPoints(0.25)
            End With

            If .ActiveWindow.View.SplitSpecial <> wdPaneNone Then
                .ActiveWindow.Panes(2).Close
            End If
            .ActiveWindow.ActivePane.View.Type = wdPrintView
            .ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
            .Selection.Style = .ActiveDocument.Styles("Heading 1")
            .Selection.TypeText Text:=Left(ActivePresentation.Name, InStrRev(ActivePresentation.Name, ".") - 1)
            .Selection.TypeText Text:="   by " & ActivePresentation.BuiltInDocumentProperties.Item("author").Value
            .ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter
            .Selection.ParagraphFormat.TabStops(InchesToPoints(6)).Position = InchesToPoints(7.5)
            .Selection.TypeText Text:=vbTab & vbTab & "Page "
            .Selection.Fields.Add Range:=.Selection.Range, Type:=wdFieldPage
            .Selection.TypeText Text:=" of "
            .Selection.Fields.Add Range:=.Selection.Range, Type:=wdFieldNumPages
            .ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument

            .Selection.MoveLeft Unit:=wdCharacter, Count:=2

            .ActiveDocument.Tables.Add Range:=.Selection.Range, NumRows:=ActivePresentation.Slides.Count, NumColumns _
                :=2, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
                wdAutoFitFixed
            With .Selection.Tables(1)
                .Columns.PreferredWidth = InchesToPoints(7.5)
            End With
            With .Selection.Tables(1)
                .TopPadding = InchesToPoints(0)
                .BottomPadding = InchesToPoints(0)
                .LeftPadding = InchesToPoints(0.08)
                .RightPadding = InchesToPoints(0.08)
                .Spacing = 0
                .AllowPageBreaks = True
                .AllowAutoFit = False
            End With
            .Selection.Tables(1).Columns(1).PreferredWidthType = wdPreferredWidthPoints
            .Selection.Tables(1).Columns(1).PreferredWidth = InchesToPoints(3)
            .Selection.Move Unit:=wdColumn, Count:=1
            .Selection.SelectColumn
            .Selection.Columns.PreferredWidthType = wdPreferredWidthPoints
            .Selection.Columns.PreferredWidth = InchesToPoints(4.5)

            .Selection.MoveLeft Unit:=wdCharacter, Count:=2

            For i = 1 To ActivePresentation.Slides.Count
                .Selection.InlineShapes.AddPicture FileName:="C:\Presentation Slides\Slide" & Format(i) & ".JPG", LinkToFile:=False, SaveWithDocument:=True
                .Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
                .Selection.InlineShapes(1).LockAspectRatio = msoTrue
                .Selection.InlineShapes(1).Width = 203.05
                .Selection.InlineShapes(1).Height = 152.65
                .Selection.MoveRight Unit:=wdCharacter, Count:=2
                With .Selection.Font
                    .Name = "Times New Roman"
                    .Size = 8
                    .Bold = False
                End With
                .Selection.TypeText Text:=ActivePresentation.Slides(i).NotesPage.Shapes.Placeholders(2).TextFrame.TextRange.Text
                .Selection.MoveDown Unit:=wdLine, Count:=1
                .Selection.MoveLeft Unit:=wdCharacter, Count:=1
            Next i
        End With
    End If
    Set objWord = Nothing
End Sub

—————

Anyone else have additional ideas for adding features to PowerPoint based Oracle Presentation Files?