VBA Macro to Create PowerPoint Slides

Automating Your Presentation - Chat GPT

Note: Change the path to where you want to save your presentation

​

​

Sub AutomatePowerPointPresentation()
    Dim pptApp As Object
    Dim pptPres As Object
    Dim slideIndex As Integer
    
    ' Create PowerPoint application object
    Set pptApp = CreateObject("PowerPoint.Application")
    pptApp.Visible = True ' Make PowerPoint application visible
    
    ' Create a new presentation
    Set pptPres = pptApp.Presentations.Add
    
    ' Add slides with titles and content
    slideIndex = 1
    
    ' Add slide 1 with title
    With pptPres.Slides.Add(slideIndex, ppLayoutTitle)
        .Shapes(1).TextFrame.TextRange.Text = "Introduction"
    End With
    slideIndex = slideIndex + 1
    
    ' Add slide 2 with title and content
    With pptPres.Slides.Add(slideIndex, ppLayoutText)
        .Shapes(1).TextFrame.TextRange.Text = "Main Points"
        .Shapes(2).TextFrame.TextRange.Text = "Point 1" & vbCrLf & "Point 2" & vbCrLf & "Point 3"
    End With
    slideIndex = slideIndex + 1
    
    ' Add slide 3 with title and content
    With pptPres.Slides.Add(slideIndex, ppLayoutText)
        .Shapes(1).TextFrame.TextRange.Text = "Conclusion"
        .Shapes(2).TextFrame.TextRange.Text = "Wrap-up and final thoughts."
    End With
    
    ' Save the presentation
    Dim filePath As String
    filePath = "C:\Users\YourUsername\Documents\AutomatedPresentation.pptx" ' Specify the file path
    pptPres.SaveAs filePath
    
    ' Close PowerPoint application
    pptApp.Quit
    
    ' Clean up
    Set pptPres = Nothing
    Set pptApp = Nothing
    
    MsgBox "Presentation has been created and saved successfully!"
End Sub
 

​