​

​

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
    
 

 

​