Visit my Youtube Channel
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