XL 2016 Filtre automatiquement avec VBA excel et powerpoint

=SOUS.TOTAL(101;Tableau2[Note])

Sub CréerPrésentationPPT()

'Si Microsoft PowerPoint xx.x Object Library mise en référence (Early Bindind)
'     Dim PPT As New PowerPoint.Application
'     Dim Prés As PowerPoint.Presentation
'     Dim Diapo As PowerPoint.Slide
'     Dim Shp As PowerPoint.Shape
    
'Si Microsoft PowerPoint xx.x Object Library NON mise en référence (Late Binding)
     Dim pptApp As Object, Prés As Object, Diapo As Object, Shp As Object
     Set pptApp = CreateObject("PowerPoint.Application")    'Nouvelle application PowerPoint
    
     Dim LstCode(), Eval(), i As Long, j As Long, k As Long
    
     LstCode = [tb_CodeSTART].Value2    'Valeurs du tableau listant les "Code START"
     Eval = [tb_Eval].Value2            'Valeurs du tableau d'évaluation
    
     Set Prés = PPT.Presentations.Add                       'Nouvelle présentation PowerPoint vide
    
'Boucle sur tous les "Code START"
     For i = 1 To UBound(LstCode)
          Somme = 0: nb = 0                            'Initialisation pour calculer la moyenne
     'Boucle sur les évaluation
          For j = 1 To UBound(Eval)
               If Eval(j, 3) = LstCode(i, 1) Then
                    Somme = Somme + Eval(j, 1)         'Cumul des évaluations pour ce code
                    nb = nb + 1                        'Nbre d'évaluations pour ce code
               End If
          Next j
          
          If nb > 0 Then                               'Si il y a des évaluations pour ce code
          k = k + 1                                    'Compteur des diapos
               Moyenne = Somme / nb
               Set Diapo = Prés.Slides.Add(k, 12)                               'Ajout d'une diapo
               Diapo.Name = LstCode(i, 1)                                       'Nommer la diapo
               With Diapo.Shapes.AddShape(msoShapeRectangle, 70, 170, 110, 22)  'Ajout d'un rectangle pour contenir le Code START
                    .Name = "Shp " & LstCode(i, 1)                              'Nommer le rectangle
                    .TextFrame.TextRange.Text = LstCode(i, 1)                   'Texte = Code START
                    .TextFrame.TextRange.Font.Size = 14                         'Modification de la taille du texte
               End With
               With Diapo.Shapes.AddShape(msoShapeRectangle, 190, 170, 110, 22) 'Ajout d'un rectangle pour contenir la moyenne
                    .Name = "Moy " & LstCode(i, 1)                              'Nommer le rectangle
                    .TextFrame.TextRange.Text = Format(Moyenne, "0.00")         'Texte = moyenne (2 décimales)
                    .TextFrame.TextRange.Font.Size = 14                         'Modification de la taille du texte
               End With
              
          End If
     Next
     PPT.Visible = msoCTrue   'Afficher la présentation
End Sub

Sub NommerDiapo()

     Dim Prés As Presentation, Sld As Slide, Rép$
     Dim Dc As Object
     
     Set Prés = ActivePresentation
     Set Dc = CreateObject("Scripting.Dictionary")
     
     'Vérification du type d'affichage
     If ActiveWindow.ViewType <> ppViewNormal And ActiveWindow.ViewType <> ppViewOutline And ActiveWindow.ViewType <> ppViewSlideSorter Then
          MsgBox "Choisir mode d'affichage Normal, Mode Plan ou Trieuse de Diapositives", vbExclamation, "Nommer la diapositive"
          Exit Sub
     End If
     'Collecte des noms des diapositives de la présentation dans le dictionnaire Dc
     For Each Sld In Prés.Slides
          Dc(Sld.Name) = ""
     Next
     
     'Recherche de la diapositive active
     Set Sld = Nothing
     On Error Resume Next
     Set Sld = ActiveWindow.View.Slide
     On Error GoTo 0
     If Sld Is Nothing Then MsgBox "Pas de Diapositive dans cette vue !": Exit Sub
     
     'Demande du nom à affecter à la diapositive active
     Rép = InputBox("Nom pour la diapositive """ & Sld.Name & """ ?", "Nommer la diapositive")
     If Rép = "" Then Exit Sub
     
     'Vérification que le nom n'est pas déjà attribué à une diapositive
     If Dc.Exists(Rép) Then MsgBox "Une diapositive nommée " & Rép & " existe déjà !": Exit Sub
     
     'Affectation du nom saisi à la diapositive active
     Sld.Name = Rép
     
End Sub

Sub MàJ_PPT()
'Si Early binding ("Microsoft PowerPoint xx.x Object Library" et "Microsoft Scripting Runtime" mises en référence)
'     Dim AppPPT As New PowerPoint.Application
'     Dim Prés As PowerPoint.Presentation
'     Dim Diapo As PowerPoint.Slide
'     Dim Shp As PowerPoint.Shape
'
'     Dim DC As New Scripting.Dictionary
    
    
'Si Late Binding
     Dim AppPPT As Object, Prés As Object, Diapo As Object, Shp As Object
     Set AppPPT = CreateObject("PowerPoint.Application")    'Nouvelle application PowerPoint
     Dim DC As Object
     Set DC = CreateObject("Scripting.Dictionary")
    
    
     Dim LstCode(), Eval(), i As Long, j As Long, k As Long
     Dim Somme As Double, Moyenne$, Nom$

     LstCode = [tb_CodeSTART].Value2    'Valeurs du tableau listant les "Code START"
     Eval = [tb_Eval].Value2            'Valeurs du tableau d'évaluation
    
'Calcul des moyennes pour tous les "Code START"
     For i = 1 To UBound(LstCode)
          Somme = 0: nb = 0                            'Initialisation pour calculer la moyenne
     'Boucle sur les évaluations
          For j = 1 To UBound(Eval)
               If Eval(j, 3) = LstCode(i, 1) Then
                    Somme = Somme + Eval(j, 1)         'Cumul des évaluations pour ce code
                    nb = nb + 1                        'Nbre d'évaluations pour ce code
               End If
          Next j
          
          If nb > 0 Then                               'Si il y a des évaluations pour ce code
          k = k + 1                                    'Compteur des diapos
               Moyenne = Format(Somme / nb, "0.00")    'Si plusieurs évaluations
          Else
               Moyenne = ""                            'Si aucune évaluation
          End If
          DC(LstCode(i, 1)) = Moyenne                  'Moyenne placée dans le dictionnaire
     Next
    
'Modifier la présentation pour y inclure les moyennes
     MaPrésentation = ThisWorkbook.Path & "\ppt5E35.pptm"
     Set Prés = AppPPT.Presentations.Open(MaPrésentation)
     AppPPT.Visible = msoCTrue
    
     'Boucle sur toutes les diapositives de la présentation
     For Each Diapo In Prés.Slides
          Nom = Diapo.Name                             'Nom de la diapo
          If DC.Exists(Nom) Then                       'Est-ce-que ce nom est l'un de "Code START"
               On Error Resume Next
               Diapo.Shapes("Moy_" & Nom).TextFrame.TextRange.Text = DC(Nom)    'Si la forme moyenne du Code STAR existe on écrit la moyenne
               On Error GoTo 0
          End If
     Next
    
'Sauvegarde et fermeture
     Prés.Save
     Prés.Close
     AppPPT.Quit: Set AppPPT = Nothing: Set Prés = Nothing: Set Diapo = Nothing
     Set DC = Nothing
    
End Sub

Sub NommerDiapo()

     Dim Prés As Presentation, Sld As Slide, Rép$
     Dim Dc As Object
    
     Set Prés = ActivePresentation
     Set Dc = CreateObject("Scripting.Dictionary")
    
     'Vérification du type d'affichage
     If ActiveWindow.ViewType <> ppViewNormal And ActiveWindow.ViewType <> ppViewOutline And ActiveWindow.ViewType <> ppViewSlideSorter Then
          MsgBox "Choisir mode d'affichage Normal, Mode Plan ou Trieuse de Diapositives", vbExclamation, "Nommer la diapositive"
          Exit Sub
     End If
     'Collecte des noms des diapo de la présentation dans le dictionnaire Dc
     For Each Sld In Prés.Slides
          Dc(Sld.Name) = ""
     Next
    
     'Recherche de la diapo active
     Set Sld = Nothing
     On Error Resume Next
     Set Sld = ActiveWindow.View.Slide
     On Error GoTo 0
     If Sld Is Nothing Then MsgBox "Pas de Diapositive dans cette vue !": Exit Sub
    
     'Demande du nom à affecter à la diapo active
     Rép = InputBox("Nom pour la diapositive """ & Sld.Name & """ ?", "Nommer la diapositive")
     If Rép = "" Then Exit Sub
    
     'Vérification que le nom n'est pas déjà attribué à une diapo
     If Dc.Exists(Rép) Then MsgBox "Une diapositive nommée " & Rép & " existe déjà !": Exit Sub
    
     'Affectation du nom saisi à la diapo active
     Sld.Name = Rép
    
End Sub