Sub CreateEconomicReformsPresentation()
Dim pptApp As Object
Dim pptPresentation As Object
Dim pptSlide As Object
Dim slideTitle As String
Dim slideCount As Integer
' Create a new PowerPoint application
Set pptApp = CreateObject("PowerPoint.Application")
pptApp.Visible = True
' Create a new presentation
Set pptPresentation = pptApp.Presentations.Add
' Loop to create 8 slides
For slideCount = 1 To 8
' Define slide title
slideTitle = "Business Environment 1.0"
' Add a new slide with title
Set pptSlide = pptPresentation.Slides.Add(slideCount, ppLayoutText)
pptSlide.Shapes(1).TextFrame.TextRange.Text = slideTitle
' Format the title
pptSlide.Shapes(1).TextFrame.TextRange.Font.Size = 60
pptSlide.Shapes(1).TextFrame.TextRange.Font.Bold = True
pptSlide.Shapes(1).Fill.ForeColor.RGB = RGB(255, 255, 0) ' Bright Yellow
' Clean up
Set pptSlide = Nothing
Next slideCount
' Save the presentation to the default documents folder
Dim DefaultFolderPath As String
DefaultFolderPath = Environ("USERPROFILE") & "\Documents\"
pptPresentation.SaveAs DefaultFolderPath & "Economic_Reforms_1991.pptx"
' Clean up
Set pptPresentation = Nothing
Set pptApp = Nothing
End Sub