vbaloopspowerpointslidepresentation

how to loop through the nth slide powerpoint vba


I have the following code to create a progress bar in a PowerPoint presentation

Sub BarreDeProgression()
'Génère une barre de progression

'Valeurs à adapter selon besoin
Const Longueur As Single = 1    'Longueur totale de la barre (% de  la longueur de la diapo (0.25 =25%))
Const Hauteur As Single = 0.02     'Hauteur totale de la barre (% de  la hauteur de la diapo)
Const PositionX As Single = 0.1       'Position en X de la barre (% de  la longueur de la diapo en partant de la gauche)
Const PositionY As Single = 0.05   'Position en Y de la barre (% de  la hauteur de la diapo en partant de la gauche)


'Récupération des infos
Set Pres = ActivePresentation
H = Pres.PageSetup.SlideHeight
W = Pres.PageSetup.SlideWidth * Longueur
nb = Pres.Slides.Count
Counter = 1

'Pour chaque Slide
For Each SLD In Pres.Slides

        'Supprime l'ancienne barre de progression
        nbShape = SLD.Shapes.Count
        del = 0
        For a = 1 To nbShape
            If Left(SLD.Shapes.Item(a - del).Name, 2) = "PB" Then
                SLD.Shapes.Item(a - del).Delete
                del = del + 1
            End If
        Next
    
    'pose la nouvelle barre de progression
        For i = 0 To nb - 1
            Set OBJ = SLD.Shapes.AddShape(msoShapeChevron, (W * i / nb) + W / nb * (PositionX / 2), H * (1 - PositionY), (W / nb) * (1 - PositionX), H * Hauteur)
            OBJ.Name = "PB" & i
            OBJ.Line.Visible = msoFalse
            If i + 1 = Counter Then
                OBJ.Fill.ForeColor.RGB = RGB(156, 156, 156)
            Else
                OBJ.Fill.ForeColor.RGB = RGB(216, 32, 39)
            End If
        Next
    
        Counter = Counter + 1
Next
    
End Sub

The problem is that code loops through all slide and create a progress bar in all slide, but I don't want the bar in the first, in the introduction and i the conclusion. How can I fix it ? I thought to add and if condition where I specify that the slide number should be greater than 4, but it did not work. Thanks in advance.


Solution

  • In the long run, you should get in the habit of declaring variables. An example in this code is Dim X As Integer. When you do this, the variable acquires the properties and methods of the declared object type. If you don't declare them, they are all variants, and the application must guess which properties and methods apply.

    In this version of your code, I removed the variant variable SLD, since that will apply the code to all members of the slides collection. I replaced it with a count of the number of slides. Then I was able to come up with a conditional statement that leaves out the first 2 and the last slides. I also adjusted the calculation of the nb variable to reduce it by three. This ensures the number of shapes totals the number of slides that display the shapes.

    Here's the revised code:

    Sub BarreDeProgression()
    Dim X As Integer
    'Génère une barre de progression
    
    'Valeurs à adapter selon besoin
    Const Longueur As Single = 1    'Longueur totale de la barre (% de  la longueur de la diapo (0.25 =25%))
    Const Hauteur As Single = 0.02     'Hauteur totale de la barre (% de  la hauteur de la diapo)
    Const PositionX As Single = 0.1       'Position en X de la barre (% de  la longueur de la diapo en partant de la gauche)
    Const PositionY As Single = 0.05   'Position en Y de la barre (% de  la hauteur de la diapo en partant de la gauche)
    
    'Récupération des infos
    Set Pres = ActivePresentation
    H = Pres.PageSetup.SlideHeight
    W = Pres.PageSetup.SlideWidth * Longueur
    nb = Pres.Slides.Count
    Counter = 1
    
    'Pour chaque Slide
    For X = 1 To Pres.Slides.Count
        If X > 2 And X < (Pres.Slides.Count) Then
    
            'Supprime l'ancienne barre de progression
            nbShape = Pres.Slides(X).Shapes.Count
            del = 0
            For a = 1 To nbShape
                If Left(Pres.Slides(X).Shapes.Item(a - del).Name, 2) = "PB" Then
                    Pres.Slides(X).Shapes.Item(a - del).Delete
                    del = del + 1
                End If
            Next
        
        'pose la nouvelle barre de progression
            For I = 0 To nb - 1
                Set OBJ = Pres.Slides(X).Shapes.AddShape(msoShapeChevron, (W * I / (nb - 3)) + W / (nb - 3) * (PositionX / 2), H * (1 - PositionY), (W / (nb - 3)) * (1 - PositionX), H * Hauteur)
                OBJ.Name = "PB" & I
                OBJ.Line.Visible = msoFalse
                If I + 1 = Counter Then
                    OBJ.Fill.ForeColor.RGB = RGB(156, 156, 156)
                Else
                    OBJ.Fill.ForeColor.RGB = RGB(216, 32, 39)
                End If
            Next
        
            Counter = Counter + 1
        End If
    Next X
        
    End Sub