PowerPoint VBA进度条代码优化：跳过指定幻灯片生成进度条

我有一段PowerPoint VBA代码用于生成幻灯片进度条，但目前会给所有幻灯片添加进度条。我希望排除第1张幻灯片、介绍页（第2-4页）和最后一张结论页，之前尝试添加幻灯片编号>4的判断但没成功，求解决方法。

原代码如下：

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

要排除指定幻灯片，需在遍历循环中添加条件判断跳过目标页面，同时保证进度计数器正常递增，避免后续页面进度显示错误。

修改后的代码 #

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)

' 定义需要排除的幻灯片编号，可根据实际情况调整
Dim excludedSlides As Variant
excludedSlides = Array(1, 2, 3, 4, Pres.Slides.Count) ' 第1页、2-4页（介绍页）、最后一页（结论页）

'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
    ' 清理当前幻灯片的旧进度条（排除页也需要清理残留）
    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
    
    ' 判断当前幻灯片是否在排除列表中，是则跳过进度条生成
    If Not IsInArray(SLD.SlideIndex, excludedSlides) Then
        '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
    End If
    
    ' 无论是否生成进度条，计数器都要递增，保证进度显示准确
    Counter = Counter + 1
Next
    
End Sub

' 辅助函数：检查目标值是否在数组中
Function IsInArray(valToCheck As Variant, arr As Variant) As Boolean
    Dim element As Variant
    For Each element In arr
        If element = valToCheck Then
            IsInArray = True
            Exit Function
        End If
    Next element
    IsInArray = False
End Function

关键修改说明 #

• 自定义排除列表：通过数组excludedSlides指定不需要生成进度条的幻灯片编号，可随时根据实际页面结构调整。
• 跳过逻辑：借助IsInArray辅助函数判断当前幻灯片是否在排除列表中，直接跳过进度条生成步骤。
• 计数器正常递增：即使跳过幻灯片，Counter仍保持递增，确保后续页面的进度条能正确显示当前位置。
• 清理残留进度条：所有幻灯片都会清理旧的PB开头形状，避免排除页残留旧进度条。

内容的提问来源于stack exchange，提问作者user14598940