Untitled

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