Insert a progress bar to Powerpoint presentation .md

Intro

To view the progress of a Powerpoint presentation, a progress bar can be displayed at the bottom of the slide show.

How to proceed

Once the slideshow is complete, go to Tools > Macro > Visual Basic Editor.

In the new window, select Insert > Module and copy this text in the blank page:

Sub AddProgressBar()
    On Error Resume Next
        With ActivePresentation
              sHeight = .PageSetup.SlideHeight - 12
              n = 0
              j = 0
              For i = 1 To .Slides.Count
                If .Slides(i).SlideShowTransition.Hidden Then j = j + 1
              Next i:
              For i = 2 To .Slides.Count
                .Slides(i).Shapes("progressBar").Delete
                If .Slides(i).SlideShowTransition.Hidden = msoFalse Then
                  Set slider = .Slides(i).Shapes.AddShape(msoShapeRectangle, 0, sHeight, (i - n) * .PageSetup.SlideWidth / (.Slides.Count - j), 12)
                  With slider
                      .Fill.ForeColor.RGB = ActivePresentation.SlideMaster.ColorScheme.Colors(ppFill).RGB
                      .Name = "progressBar"
                  End With
                Else
                   n = n + 1
                End If
              Next i:
        End With
End Sub

Then go to File > Close > Return to Microsoft PowerPoint In the displayed page of Microsoft Powerpoint, go to: Tools > Macro > Macros, then select AddProcessBar and press Execute

How remove the progress bar?

To remove the progress bar make we can add the following function:

Sub RemoveProgressBar()
    On Error Resume Next
        With ActivePresentation
              For i = 1 To .Slides.Count
              .Slides(i).Shapes("progressBar").Delete
              Next i:
        End With
End Sub

PPT-Progress-Bar-with-Page-Numbers.vbs

'' Add progress bar and page numbers to all non-hidden pages
Sub AddProgressBar()
    On Error Resume Next
        With ActivePresentation
              sHeight = .PageSetup.SlideHeight - 12
              n = 0
              j = 0
              For i = 1 To .Slides.Count
                If .Slides(i).SlideShowTransition.Hidden Then j = j + 1
              Next i:
              For i = 2 To .Slides.Count
                .Slides(i).Shapes("progressBar").Delete
                .Slides(i).Shapes("pageNumber").Delete
                If .Slides(i).SlideShowTransition.Hidden = msoFalse Then
                  Set slider = .Slides(i).Shapes.AddShape(msoShapeRectangle, 0, sHeight, (i - n) * .PageSetup.SlideWidth / (.Slides.Count - j), 12)
                  With slider
                      .Fill.ForeColor.RGB = ActivePresentation.SlideMaster.ColorScheme.Colors(ppFill).RGB
                      .Name = "progressBar"
                  End With
                  Set pageNumber = .Slides(i).Shapes.AddTextbox(msoTextOrientationHorizontal, ((i - n) * .PageSetup.SlideWidth / (.Slides.Count - j)) - 40, .PageSetup.SlideHeight - 15, 100, 10)
                  With pageNumber
                      .TextFrame.TextRange.Text = Str(i - n) & "/" & Str(ActivePresentation.Slides.Count - j)
                       With .TextFrame.TextRange.Font
                           .Bold = msoFalse
                           .Size = 10
                       End With
                       .Name = "pageNumber"
                   End With
                  Else
                    n = n + 1
                  End If
              Next i:
        End With
End Sub

'' Macro to remove the progress bar from all the slides
Sub RemoveProgressBar()
    On Error Resume Next
        With ActivePresentation
              For i = 1 To .Slides.Count
              .Slides(i).Shapes("progressBar").Delete
              .Slides(i).Shapes("pageNumber").Delete
              Next i:
        End With
End Sub

PPT-Progress-Bar.vbs

'' Add progress bar only to all non-hidden pages
Sub AddProgressBar()
    On Error Resume Next
        With ActivePresentation
              sHeight = .PageSetup.SlideHeight - 12
              n = 0
              j = 0
              For i = 1 To .Slides.Count
                If .Slides(i).SlideShowTransition.Hidden Then j = j + 1
              Next i:
              For i = 2 To .Slides.Count
                .Slides(i).Shapes("progressBar").Delete
                If .Slides(i).SlideShowTransition.Hidden = msoFalse Then
                   Set slider = .Slides(i).Shapes.AddShape(msoShapeRectangle, 0, sHeight, (i - n) * .PageSetup.SlideWidth / (.Slides.Count - j), 12)
                   With slider
                       .Fill.ForeColor.RGB = ActivePresentation.SlideMaster.ColorScheme.Colors(ppFill).RGB
                       .Name = "progressBar"
                   End With
                Else
                   n = n + 1
                End If
              Next i:
        End With
End Sub

'' Macro to remove the progress bar from all the slides
Sub RemoveProgressBar()
    On Error Resume Next
        With ActivePresentation
              For i = 1 To .Slides.Count
              .Slides(i).Shapes("progressBar").Delete
              Next i:
        End With
End Sub

PPT-SubSectionIndicator.vbs

Sub AddSubSectionIndicator()
   On Error Resume Next
        With ActivePresentation
             sHeight = .PageSetup.SlideHeight - 24
             
             Dim contents As Shape
             Set contents = .Slides(.Slides.Count).Shapes("Contnets")
             
             Dim my_string As String
             my_string = contents.TextFrame.TextRange.Text
            
             Dim sections() As String
             sections = Split(my_string, vbCr)
             
                          
             Dim totalSections As Integer
             totalSections = 8
             
             Dim pagesSection(1 To 8) As Integer
             
             pagesSection(1) = 1
             pagesSection(2) = 4
             pagesSection(3) = 14
             pagesSection(4) = 19
             pagesSection(5) = 24
             pagesSection(6) = 29
             pagesSection(7) = 33
             pagesSection(8) = 35
            
            
             For i = 2 To .Slides.Count
               If .Slides(i).SlideShowTransition.Hidden = msoFalse Then
                 '' Page Progress Bar
                 .Slides(i).Shapes("progressBar").Delete
                 Dim slider As Shape
                 Set slider = .Slides(i).Shapes.AddShape(msoShapeRectangle, 0, sHeight + 22, (i - n) * .PageSetup.SlideWidth / (.Slides.Count - j), 2)
                  With slider
                    .Fill.Transparency = 1
                    .Line.Weight = 3
                    .Line.ForeColor.RGB = RGB(100, 110, 100)
                    .Name = "progressBar"
                  End With



                '' Section Indicator
                .Slides(i).Shapes("myCircle").Delete
                Dim PIndex As Integer
                 
                PIndex = 8
                For l = 1 To totalSections - 1
                    If i < pagesSection(l + 1) And i >= pagesSection(l) Then
                        PIndex = l
                   End If
                Next l
                               
                For k = 1 To totalSections
                    .Slides(i).Shapes("myCircle" + Str(k)).Delete
                    Dim circled As Shape
                    Set circled = .Slides(i).Shapes.AddShape(msoShapeOval, 10 + ((k - 1) * 32), sHeight, 12, 12)
                    With circled
                        .Fill.Transparency = 1
                        .Line.ForeColor.RGB = RGB(125, 125, 0)
                        .Name = "myCircle" + Str(k)
                    End With
                     
                    If k = PIndex Then
                       circled.Fill.ForeColor.RGB = RGB(255, 255, 110)
                       circled.Fill.Transparency = 0.2
                    End If
                Next k
                
                '' Section Title
                
                .Slides(i).Shapes("sectionTitle").Delete
                Dim sectionTitle As Shape
                Set sectionTitle = .Slides(i).Shapes.AddTextbox(msoTextOrientationHorizontal, 10 + totalSections * 32, sHeight - 6, 140, 10)
                sectionTitle.TextFrame.TextRange.Text = sections(PIndex - 1)
                sectionTitle.TextFrame.TextRange.Font.Size = 12
                sectionTitle.TextFrame.TextRange.Font.Color.RGB = RGB(125, 120, 50)
                sectionTitle.Name = "sectionTitle"
                   
                '' Page Numbers

                .Slides(i).Shapes("pageNumber").Delete
                Dim pageNumber As Shape
                Set pageNumber = .Slides(i).Shapes.AddTextbox(msoTextOrientationHorizontal, .PageSetup.SlideWidth - 50, .PageSetup.SlideHeight - 25, 50, 10)
                With pageNumber
                    .TextFrame.TextRange.Text = Str(i - n) & " /" & Str(ActivePresentation.Slides.Count - j)
                    .TextFrame.TextRange.Font.Color.RGB = RGB(255, 255, 255)
                    With .TextFrame.TextRange.Font
                        .Bold = msoFalse
                        .Size = 10
                    End With
                    .Name = "pageNumber"
                End With
                
                
                
                End If
              Next i:
        End With
End Sub