Create a PowerPoint Slide Deck With Dynamic Commentary

Note: This webpage is designed to accompany the Youtube video posted above. The video offers detailed explanation on all topics; while this webpage will serve as a repository for the code presented in the video.

Each code block covered in the video is given below.

Create a FULL Corporate Style PowerPoint Slide Deck based on Tables and Charts from Excel using Excel VBA. Automate the repetitive task of creating routine slide desks every month.

We will learn how to interact with PowerPoint and manipulate its slide from Excel using the PowerPoint Object library. Leverage the PowerPoint Slide Master to create Professional looking PowerPoint Slide Layout and then, create the slides using those templates.

We will do some setup in Excel to facilitate our end goal. Data will be saved within an Excel table, so that the data range is dynamic. Report will be static and based off formulas, so that we don’t need to run VBA over it. Create a named Pivot Chart and use Page Filters to manipulate the view via VBA. Once, the setup is done, our macro will copy data onto the PowerPoint slides.

We will also, build some logic to add dynamic commentary based off values from the Excel sheets. e.g. If variance is negative, we will add comments in the slides saying the Result is negative. Learn lots of tips and tricks.

Full Code

Sub CreateSlideDeck()

    ThisWorkbook.RefreshAll
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    'Open Template
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Dim pApp As PowerPoint.Application
    Set pApp = New PowerPoint.Application
    
    Dim pPres As PowerPoint.Presentation
    Set pPres = pApp.Presentations.Open(fileName:="C:\Youtube\Current\Feb 24\Powerpoint\Build\Company Slide Master.pptx", _
                                                            ReadOnly:=msoTrue)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    'Delete Existing Slides if Any
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Dim i As Long
    For i = pPres.Slides.Count To 1 Step -1
        pPres.Slides(i).Delete
    Next i
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    'Add Title Slide
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Dim pSlide As PowerPoint.Slide
    Set pSlide = pPres.Slides.Add(1, ppLayoutTitle)
    
    Dim sMonth As String, sYear As String
    sMonth = wsMain.Range("A1").Value
    sYear = wsMain.Range("B1").Value
    
    'pPres.Slides(1).Shapes(1).TextFrame.TextRange.Text = "Month End Sales Report"
'    Dim pShape As PowerPoint.Shape
'    For Each pShape In pPres.Slides(1).Shapes
'        Debug.Print pShape.Name
'    Next pShape
    pPres.Slides(1).Shapes("Title 1").TextFrame.TextRange.Text = "Month End Sales Report"
    pPres.Slides(1).Shapes("Subtitle 2").TextFrame.TextRange.Text = sMonth & " - " & sYear
    Set pSlide = Nothing
 
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    'Add Variance Table
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    'Add New Slide
    Set pSlide = pPres.Slides.Add(pPres.Slides.Count + 1, ppLayoutTitleOnly)
    'Copy Table Over
    wsMain.Range("A1").CurrentRegion.Copy
    pSlide.Shapes.PasteSpecial DataType:=ppPasteEnhancedMetafile
    'Re-Position and Re-size The Table
    With pSlide.Shapes(2)
        .Top = 150
        .Left = 100
        .Width = 400
        .Height = 350
    End With
    'Add Title
    pSlide.Shapes.Title.TextFrame.TextRange.Text = "Budget vs Actual"
    'Add commentary to the slide
    Dim dAllStoreVariance As Double
    dAllStoreVariance = wsMain.Range("E18").Value
    Dim sResult As String
    Select Case dAllStoreVariance
        Case Is >= 0.025
            sResult = "Positive"
        Case Is <= -0.025
            sResult = "Negative"
        Case Else
            sResult = "Neutral"
    End Select
    dAllStoreVariance = Application.WorksheetFunction.RoundUp(dAllStoreVariance * 100, 0)
    pSlide.Shapes.AddTextbox(msoTextOrientationHorizontal, _
                    Left:=600, Top:=200, Width:=300, Height:=50).TextFrame _
                    .TextRange.Text = "Overall " & sResult & " Result" & vbLf _
                                               & dAllStoreVariance & "% Variance vs Budget"
    With pSlide.Shapes(3).TextFrame.TextRange.Font
        .Color.RGB = RGB(255, 255, 255)
        .Name = "Arial Rounded MT Bold"
    End With
    Set pSlide = Nothing
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    'Add Individual Store Charts
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Dim sStore As String
    Dim dStoreVariance As Double
    Dim rowTotal As Long
    
    For i = 2 To 5
        sStore = wsStores.Range("A" & i).Value
        wsCharts.PivotTables("pvtProducts").PivotFields("Store").ClearAllFilters
        wsCharts.PivotTables("pvtProducts").PivotFields("Store").CurrentPage = sStore
        'Add New Slide
        Set pSlide = pPres.Slides.Add(pPres.Slides.Count + 1, ppLayoutTitleOnly)
        'Copy Chart over
        wsCharts.Shapes("chrtProducts").Copy
        pSlide.Shapes.PasteSpecial DataType:=ppPasteEnhancedMetafile
        'Re-Position and Re-size The Table
        With pSlide.Shapes(2)
            .Top = 150
            .Left = 300
            .Width = 400
            .Height = 250
        End With
         'Add Title
        pSlide.Shapes.Title.TextFrame.TextRange.Text = "Units Sold by Store " & sStore
        rowTotal = wsStores.Range("B" & i).Value
        dStoreVariance = wsMain.Range("E" & rowTotal).Value
        dStoreVariance = Application.WorksheetFunction.RoundUp(dStoreVariance * 100, 0)
         pSlide.Shapes.AddTextbox(msoTextOrientationHorizontal, _
                        Left:=50, Top:=450, Width:=800, Height:=50).TextFrame _
                        .TextRange.Text = "Total Variance vs Budget is " & dStoreVariance & "%"
        With pSlide.Shapes(3).TextFrame.TextRange.Font
            .Color.RGB = RGB(255, 255, 255)
            .Name = "Arial Rounded MT Bold"
        End With
        Set pSlide = Nothing
    Next i
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    'Save File
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Dim folderPath As String
    folderPath = "C:\Youtube\Current\Feb 24\Powerpoint\Build\"
    Dim fileName As String
    fileName = "Monthly Budget Variance " & sMonth & "_" & sYear
    
    pPres.SaveCopyAs folderPath & fileName
    pPres.Close
    
End Sub