Progress Bar Macro - Help Need from Experts

ello Macro Masters!

I have a Macro Code to insert a Progress Bar (Copy Paste & Resize an image) in PowerPoint presentation skipping pre-programmed slides (First 2 and Last 2). I need help with two things:

1. Automatically Skip Hidden Slides (Do not include Progress bar) and keep Bar Size based on Applicable Slides
2. Input Box to type Slides to Ignore (Do not apply progress Bar - Skip Slides) when macro its executed.

PowerPoint Macro File: https://drive.google.com/file/d/1bon...ew?usp=sharing

Here is the Macro Code Allocated in Module 1

Code:

---


Sub ProgressBar()


    Dim Width As Integer
    Dim MinSize As Integer
   
    ActivePresentation.Slides(1).Shapes("_ProgressBar").Visible = msoFalse
    ActivePresentation.Slides(1).Shapes("_ProgressBar").Copy


    On Error Resume Next
   
        For Each Sld In ActivePresentation.Slides
   
          For i = Sld.Shapes.Count To 1 Step -1
       
          If Sld.Shapes(i).Name = ("_ProgressBar") Then Sld.Shapes(i).Delete
   
        Next i
   
    Next Sld


  scount = ActivePresentation.Slides.Count
 
    On Error Resume Next
   
    If ActivePresentation.Slides(2).Shapes(2).Name = "_PresentationIndex" Then
       
        For j = 3 To scount - 2
     
          ActivePresentation.Slides(j).Shapes.Paste
          ActivePresentation.Slides(j).Shapes("_ProgressBar").Visible = msoTrue
       
        Next j
       
        Width = Application.ActivePresentation.PageSetup.SlideWidth
 
        MinSize = Width / scount 'Determine the min size of Progress Bar
   
        For j = 3 To scount - 3
       
          ActivePresentation.Slides(j).Shapes("_ProgressBar").Width = MinSize * j 'Bar Re-Size based on quantity of slides.
         
        Next j
 
    Else
   
        For j = 2 To scount - 2
     
          ActivePresentation.Slides(j).Shapes.Paste
          ActivePresentation.Slides(j).Shapes("_ProgressBar").Visible = msoTrue
       
        Next j
       
        Width = Application.ActivePresentation.PageSetup.SlideWidth
 
        MinSize = Width / scount 'Determine the min size of Progress Bar
   
        For j = 2 To scount - 2
       
          ActivePresentation.Slides(j).Shapes("_ProgressBar").Width = MinSize * j 'Bar Re-Size based on quantity of slides.
             
        Next j
       
            'Delete bar from "Thanks!" Page
   
            If ActivePresentation.Slides(j).Shapes("_Thanks") = True Then
               
                ActivePresentation.Slides(j).Shapes("_ProgressBar").Delete
               
            End If
   
    End If


    ActivePresentation.Slides(1).Shapes.Paste
    ActivePresentation.Slides(1).Shapes("_ProgressBar").Visible = msoFalse


End Sub

---

I copied a bunch of your slides to have more to test with so the textbox comments are out of date


Slide 1, 2, Las, and next to last - marked with circle-X so no PB

Slides 5, 10, 15,20, and 25 are hidden - marked with circle-X so no PB

To test the 'manual input' I used slides 4, 9, 14, and 19 - marked with circle-X so no PB

Code:

---

Option Explicit

Sub ProgressBar()
    Dim oPres As Presentation
    Dim oSlide As Slide
    Dim i As Long, j As Long
   
    Dim sInput As String
    Dim arySkip() As Long, aryAdd() As Long, n1 As Long, n2 As Long
   
    Set oPres = ActivePresentation
   
    'skip first 2 and last 2
    ReDim arySkip(1 To 4)
    arySkip(1) = 1
    arySkip(2) = 2
    arySkip(3) = oPres.Slides.Count - 1
    arySkip(4) = oPres.Slides.Count
   
    'get manual slide to ignore and put into arySkip
    n1 = UBound(arySkip)
    n2 = 0
    Do While True
        sInput = InputBox("Enter a slide to ignore, blank when done", "Ignore Slides")
        If Len(sInput) > 0 Then
            n1 = n1 + 1
            ReDim Preserve arySkip(1 To n1)
            arySkip(n1) = CLng(sInput)
        Else
            Exit Do
        End If
    Loop
   
    'build array of slides to add PB to in aryAdd
    For Each oSlide In ActivePresentation.Slides
        If UBound(arySkip) > 0 Then
            For i = LBound(arySkip) To UBound(arySkip)
                If arySkip(i) = oSlide.SlideNumber Then GoTo NextSlide
            Next i
        End If
       
        If oSlide.SlideShowTransition.Hidden Then GoTo NextSlide
           
        n2 = n2 + 1
        ReDim Preserve aryAdd(1 To n2)
        aryAdd(n2) = oSlide.SlideNumber
       
NextSlide:
    Next oSlide
   
    'delete any existing PB except on slide 1 to copy
    For Each oSlide In ActivePresentation.Slides
        If oSlide.SlideNumber <> 1 Then
            For i = oSlide.Shapes.Count To 1 Step -1
                If oSlide.Shapes(i).Name = ("_ProgressBar") Then oSlide.Shapes(i).Delete
            Next i
        End If
    Next oSlide
   
    'no slide gets PB
    If n2 = 0 Then Exit Sub
   
    'copy PB on slide 1
    With oPres
        For i = LBound(aryAdd) To UBound(aryAdd)
            .Slides(1).Shapes("_ProgressBar").Duplicate
            .Slides(aryAdd(i)).Shapes.Paste
            .Slides(aryAdd(i)).Shapes("_ProgressBar").Visible = msoTrue
            'Bar Re-Size based on quantity of slides.
            .Slides(aryAdd(i)).Shapes("_ProgressBar").Width = i * oPres.PageSetup.SlideWidth / UBound(aryAdd)
        Next i
    End With


End Sub

---

WOW! Works Flawless and its awesome, thanks a lot for sharing the code + PowerPoint File.

It does exactly what i need. :clap:

Quote:

---

Originally Posted by Paul_Hossler

I copied a bunch of your slides to have more to test with so the textbox comments are out of date


Slide 1, 2, Las, and next to last - marked with circle-X so no PB

Slides 5, 10, 15,20, and 25 are hidden - marked with circle-X so no PB

To test the 'manual input' I used slides 4, 9, 14, and 19 - marked with circle-X so no PB

Code:

---

Option Explicit

Sub ProgressBar()
    Dim oPres As Presentation
    Dim oSlide As Slide
    Dim i As Long, j As Long
   
    Dim sInput As String
    Dim arySkip() As Long, aryAdd() As Long, n1 As Long, n2 As Long
   
    Set oPres = ActivePresentation
   
    'skip first 2 and last 2
    ReDim arySkip(1 To 4)
    arySkip(1) = 1
    arySkip(2) = 2
    arySkip(3) = oPres.Slides.Count - 1
    arySkip(4) = oPres.Slides.Count
   
    'get manual slide to ignore and put into arySkip
    n1 = UBound(arySkip)
    n2 = 0
    Do While True
        sInput = InputBox("Enter a slide to ignore, blank when done", "Ignore Slides")
        If Len(sInput) > 0 Then
            n1 = n1 + 1
            ReDim Preserve arySkip(1 To n1)
            arySkip(n1) = CLng(sInput)
        Else
            Exit Do
        End If
    Loop
   
    'build array of slides to add PB to in aryAdd
    For Each oSlide In ActivePresentation.Slides
        If UBound(arySkip) > 0 Then
            For i = LBound(arySkip) To UBound(arySkip)
                If arySkip(i) = oSlide.SlideNumber Then GoTo NextSlide
            Next i
        End If
       
        If oSlide.SlideShowTransition.Hidden Then GoTo NextSlide
           
        n2 = n2 + 1
        ReDim Preserve aryAdd(1 To n2)
        aryAdd(n2) = oSlide.SlideNumber
       
NextSlide:
    Next oSlide
   
    'delete any existing PB except on slide 1 to copy
    For Each oSlide In ActivePresentation.Slides
        If oSlide.SlideNumber <> 1 Then
            For i = oSlide.Shapes.Count To 1 Step -1
                If oSlide.Shapes(i).Name = ("_ProgressBar") Then oSlide.Shapes(i).Delete
            Next i
        End If
    Next oSlide
   
    'no slide gets PB
    If n2 = 0 Then Exit Sub
   
    'copy PB on slide 1
    With oPres
        .Slides(1).Shapes("_ProgressBar").Visible = msoFalse
        .Slides(1).Shapes("_ProgressBar").Copy
   
        For i = LBound(aryAdd) To UBound(aryAdd)
            .Slides(1).Shapes("_ProgressBar").Duplicate
            .Slides(aryAdd(i)).Shapes.Paste
            .Slides(aryAdd(i)).Shapes("_ProgressBar").Visible = msoTrue
            'Bar Re-Size based on quantity of slides.
            .Slides(aryAdd(i)).Shapes("_ProgressBar").Width = i * oPres.PageSetup.SlideWidth / UBound(aryAdd)
        Next i
    End With


End Sub

---

---

Topic can be change to CLOSE!

If you go to [Thread Tools] above your first post, you can select [SOLVED]

BTW, you can remove these two lines - when I was cleaning up. I missed them

Code:

---

        .Slides(1).Shapes("_ProgressBar").Visible = msoFalse
        .Slides(1).Shapes("_ProgressBar").Copy

---