XL 2016 Filtre automatiquement avec VBA excel et powerpoint

[melltel]

Bonjour à tous,

Je rencontre un souci complexe et j'aurais besoin de votre aide.

J'ai deux fichiers : un fichier Excel et un fichier PowerPoint. Mon objectif est de filtrer les données sur un code start (colonne C), de récupérer la moyenne des notes correspondant à ce filtre (colonne A), et d'afficher cette moyenne dans la diapositive PowerPoint correspondant à ce code start.

Jusqu'à présent, j'ai réussie à calculer la moyenne des notes globales de tout le fichier Excel sans tenir compte des filtres. Cependant, je n'arrive pas à effectuer le filtre automatique sur le code start pour récupérer uniquement la moyenne du code correspondant.

Je pense à une autre solution : créer un module pour chaque code start et chaque diapositive PowerPoint. et renommer chaque diapo par le nom du code start

Je joins les fichiers ici pour référence.
Merci pour votre aide.

 

[AtTheOne]

Bonjour à toutes & à tous, bonjour @melltel
Est-ce que cela se produit avec mes fichiers du post #12 (non modifiés)?
sinon, peux-tu joindres des fichiers exemples pour lesquels le bug se produit (ça ressemble des tentatives d'accès à des objets par un mauvais nom)
À Bientôt

 

[melltel]

Bonjour à toutes & à tous, bonjour @melltel
Est-ce que cela se produit avec mes fichiers du post #12 (non modifiés)?
sinon, peux-tu joindres des fichiers exemples pour lesquels le bug se produit (ça ressemble des tentatives d'accès à des objets par un mauvais nom)
À Bientôt

avec ton code du post #12, j'ai plutôt une erreur d'execution :

et lorsque je fais des recherches, il s'agit toujours des cellules a nommer raison pour laquelle je les ai nommer et malheureusement les erreurs s'enchainent

 

[AtTheOne]

re
et avec mes fichiers tels quels ?

 

[melltel]

re
et avec mes fichiers tels quels ?

Oui tes deux fichiers après activation des macros

 

[AtTheOne]

re,
j'ai dû faire une erreur en joignant mes fichiers,
Teste avec ceux-ci

EDIT :
Il faut faire attention au nom du fichier PowerPoint : je l'ai mis dans une constante au début du code Excel, il est supposé être dans le même répertoire que le fichier Excel.

 

[AtTheOne]

Avec ta version il faudra faire attention à ces deux points :

J'ai dans un premier temps nommé toutes les diapos de ta présentation à l'aide de la macro "NommerDiapo" que j'ai placé dans ta présentation. (d'où l'extension ".pptm")
Celles qui doivent recevoir une moyenne porte le nom du Code START par ex D16_D16S_223B
J'ai nommé la première "ACCUEIL"

Puis j'ai nommé les rectangles devant contenir la moyenne "Moy_Code_START" avec Code_START la valeur du Code START correspondant à la diapositive.
Ces opérations accélèrent l'affectation des moyennes par la macro Excel.

 

[melltel]

Avec ta version il faudra faire attention à ces deux points :

Je te remercie @AtTheOne , ca marche nickel
Merci

 

[melltel]

Avec ta version il faudra faire attention à ces deux points :

Bonjour a tous, bonjour @AtTheOne,
s'il pourrais tu m'éclairer sur cette situation ?
en fait, j'ai ajouter certains slides et au code vba excel, une boucle qui parcours toutes les diapo et ajoute les notes a chaque présentation. sauf que je n'ai pas d'erreur et pas de réponse. J'ai regarder et selon moi il 'ya aucune erreur mais à l'execution pas de réponse.
Merci D'avance et désolé de te déranger

Voici le code que j'ai ajouter juste avant la sauvegarde et fermeture:

' Vérification si le fichier existe
If Dir(MaPrésentation) = "" Then
MsgBox "Le fichier de présentation spécifié n'existe pas: " & MaPrésentation, vbCritical
Exit Sub
End If

' Vérification si la présentation est déjà ouverte
Dim PrésDéjàOuverte As Boolean
PrésDéjàOuverte = False

On Error Resume Next
For Each Prés In AppPPT.Presentations
If Prés.FullName = MaPrésentation Then
PrésDéjàOuverte = True
Exit For
End If
Next Prés
On Error GoTo 0

If Not PrésDéjàOuverte Then
On Error GoTo ErrHandler
' Ouverture de la présentation
Set Prés = AppPPT.Presentations.Open(MaPrésentation)
Else
' Si la présentation est déjà ouverte, obtenir une référence à celle-ci
Set Prés = AppPPT.Presentations(MaPrésentation)
End If

AppPPT.Visible = True

' Boucle sur toutes les diapositives de la présentation
For Each Diapo In Prés.Slides
For Each Shp In Diapo.Shapes
If Shp.HasTextFrame Then
Nom = Replace(Shp.Name, "Moy_", "") ' Enlever le préfixe "Moy_" pour obtenir le code
If DC.Exists(Nom) Then
On Error Resume Next
Shp.TextFrame.TextRange.Text = DC(Nom)
If Err.Number <> 0 Then
Debug.Print "Erreur en mettant à jour la forme: " & Shp.Name & " avec la valeur: " & DC(Nom)
Err.Clear
End If
On Error GoTo 0
Else
Debug.Print "Nom non trouvé dans le dictionnaire: " & Nom
End If
End If
Next Shp
Next Diapo

 

[AtTheOne]

Bonjour à toutes & à tous, bonjour @melltel
Peux-tu renvoyer tes fichiers avec le code complet ?
À bientôt

 

[melltel]

Bonjour à toutes & à tous, bonjour @melltel
Peux-tu renvoyer tes fichiers avec le code complet ?
À bientôt

Oui oui, désolé pour le temps mis
Pour le PPT, stp tu peux dupliquer les diaspo du précédent fichier? Car au delà de 3 diaspo chez moi, je suis a 2Mo et le fichier devient trop volumieux pour le partager ici.

Merci

 

[AtTheOne]

Bonsoir à toutes & à tous, bonsoir @melltel
Je regarde cela ce soir ...

 

[AtTheOne]

Re,
Pourquoi ne nommes-tu pas tes diapos comme je l'ai fait (avec la macro que je t'ai fourni) ?

 

[melltel]

Bonjour à toutes & à tous, bonjour @melltel
Peux-tu renvoyer tes fichiers avec le code complet ?
À bientôt

Re,
Pourquoi ne nommes-tu pas tes diapos comme je l'ai fait (avec la macro que je t'ai fourni) ?

Normalement j'ai tout renommé mais ca parait plus une limite au niveau des diaspos

 

[AtTheOne]

Bonjour à toutes & à tous, bonjour @melltel
Bon je me suis penché sur ton problème :

1er point, il faut être rigoureux dans la saisie des "CodeSTART" certains commençaient par un retour chariot, la notation des suffixes lorsqu'ils existent n'était pas homogène ( _OP et -oP _ ou - pour séparer). J'ai choisi comme séparateur pour ces suffixes le - et utilisé comme 1ère lettre une minuscule et comme 2ème lettre une majuscule.
Il reste donc ces trois code avec suffixe :

D16_D16S_230-aG

D16_D16S_230-oC

D16_D16S_230-oP

Tu fais les corrections que tu souhaites, mais sois rigoureux car sinon on peux ne pas trouver des diapositives qui correspondent.

2ème point, j'ai créer une macro qui recense les "CodeSTART" dans la feuille Tables et calcule les moyennes (par formule)
la macro se trouve dans le module "mdl_MàJ_Liste_CodeSTART" macro "MàJ_Liste_CodeSTART" elle est appelée lors de l'activation de la feuille "Tables" et par la macro de mise à jour de la présentation.
Cela te permettra de détecter d'éventuelles anomalies.

'Macro de mise à jour de la liste des CodeSTART dans l'onglet "Tables"
Sub MàJ_Liste_CodeSTART()
   
     'Mise à jour de la liste des "CodeSTART"
   
     Dim tablo, DC As Object
   
     'RàZ du tableau
     With sh_Tables.[tb_CodeSTART]
          .Offset(1, 0).ClearContents
          .ListObject.Resize .ListObject.Range.Resize(2)
          .Cells(1).ClearContents
     End With
   
     'Liste des "CodeSTART"
     Set DC = CreateObject("Scripting.Dictionary")
     tablo = [tb_Eval[Code START]].Value2
     For i = 1 To UBound(tablo, 1)
          DC(tablo(i, 1)) = ""
     Next
   
     'Affectation de la liste au tableau
     sh_Tables.[tb_CodeSTART[Code START]].Resize(DC.Count, 1).Value2 = WorksheetFunction.Transpose(DC.keys)
   
     'Tri dans l'ordre croissant
     With sh_Tables.[tb_CodeSTART].ListObject
          .Sort.SortFields.Clear
          .Sort.SortFields _
               .Add2 Key:=[tb_CodeSTART[Code START]], SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers
          .Sort.Header = xlYes
          .Sort.MatchCase = False
          .Sort.Orientation = xlTopToBottom
          .Sort.Apply
     End With
   
End Sub

3ème point, je reste sur le choix de nommer les diapositives avec le "CodeSTART" qui leur correspond.
La diapo du stage "D16_D16S_223B" se nommera "D16_D16S_223B", l'accès est alors plus direct que de faire des recherches de texte dans toutes les diapos.
Pour cela je t'ai préparé une macro dans PowerPoint
Ouvre le fichier joint "Macro de nommage des diapos.pptm"
Une diapo d'accueil donne le mode opératoire (n'oublie pas d'adapter la constante du nom du PPT à modifier)

La macro de nommage (elle est prévue pour fonctionner avec 2 présentations ouvertes (celle de la macro et celle dont il faut nommer les diapos)

Public Prés As Presentation, Sld As Slide

Sub NommerDiapo()
 
     Nb = Application.Presentations.Count
     If Nb > 2 Then
          MsgBox "Fermez d'abord les autres présentations !" & Chr(10) & "il y a " & Nb & " présentations ouvertes"
          Exit Sub
     End If
     Set Prés = Application.Presentations(MaPrésentation)
   
     Prés.Windows(1).ViewType = ppViewSlide
   
     For Each Sld In ActivePresentation.Slides
          Sld.Select
          Nom = Sld.Name
          With UsF_Nommage
               .Lbl_Nom.Caption = Nom
               .Show
          End With
     Next

End Sub

Le Formulaire:

Private Sub UserForm_Initialize()
     Me.Left = 0
     Me.Top = 0
     Me.TBx_Nom.Text = ""
End Sub

Private Sub CBn_Valider_Click()
     Dim Dc As Object, Diapo As Slide
     If Me.TBx_Nom.Text <> "" Then
         
          'Collecte des noms des diapositives de la présentation dans le dictionnaire Dc
          'comme on change les noms il faut mettre à jour le dictionnaire à chaque diapo !
          Set Dc = CreateObject("Scripting.Dictionary")
          For Each Diapo In Prés.Slides
               Dc(UCase(Diapo.Name)) = ""
          Next
          If Dc.exists(UCase(Me.TBx_Nom.Text)) And UCase(Sld.Name) <> UCase(Me.TBx_Nom.Text) Then
               MsgBox "Ce nom de diapositive existe déjà dans la présentation !"
               With Me.TBx_Nom
                    .SetFocus
                    .SelStart = 0
                    .SelLength = .TextLength
               End With
               Exit Sub
          Else
               Sld.Name = Me.TBx_Nom.Text
               Unload Me
          End If
         
     End If
End Sub


Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
     If CloseMode = 0 Then
          MsgBox "Abandon pour cette diapositive !"
          Me.TBx_Nom.Text = ""
     End If
End Sub

4ème point, j'ai repris ma macro de mise à jour dans le module "mdl_MàJ_PPT" macro "MàJ_PPT"
en reprenant une partie de tes adaptations
NE PAS OUBLIER D'ADAPTER LA CONSTANTE "NomFichPPT" dans le module "Constantes"

'=========================================================
'Constante à adapter en fonction du nom de ta présentation
'=========================================================
Public Const NomFichPPT$ = "ppt5E35 testé.pptm"

'Mise à jour des moyennes par CodeSTART dans le diaporama

Sub MàJ_PPT()
    
     ' Late Binding
     Dim AppPPT As Object, Prés As Object, Diapo As Object, Shp As Object
     Dim DC As Object
     Dim MaPrésentation As String

     'mise à jour de la liste des "CodeSTART" avec les moyennes
     MàJ_Liste_CodeSTART
    
     Set AppPPT = CreateObject("PowerPoint.Application")
     Set DC = CreateObject("Scripting.Dictionary")
    
     'lecture des codeSTART avec les moyennes
     tablo = [tb_CodeSTART].Value2
     For i = 1 To UBound(tablo, 1)
          DC(tablo(i, 1)) = tablo(i, 2)
     Next
    
     'Accès à la présentation :
     MaPrésentation = ThisWorkbook.Path & "\" & NomFichPPT
    
     ' Vérification si le fichier existe
     If Dir(MaPrésentation) = "" Then
         MsgBox "Le fichier de présentation spécifié n'existe pas: " & MaPrésentation, vbCritical
         Exit Sub
     End If
     ' Vérification s'il est déjà ouvert
     Set Prés = Nothing
     On Error Resume Next
          Set Prés = AppPPT.Presentations(MaPrésentation)
     On Error GoTo 0
    
     On Error GoTo ErrHandler
     If Prés Is Nothing Then
          Set Prés = AppPPT.Presentations.Open(MaPrésentation)
     End If
     On Error GoTo 0
    
     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 "CodeSTART"
               On Error Resume Next
               Diapo.Shapes("Moy_" & Nom).TextFrame.TextRange.Text = Format(DC(Nom), "0.0")   'Si la forme moyenne du CodeSTAR existe on écrit la moyenne
               On Error GoTo 0
          End If
     Next
     Set AppPPT = Nothing
     Set Prés = Nothing
     Set Diapo = Nothing
     Set DC = Nothing
     Exit Sub

ErrHandler:
     MsgBox "Une erreur est survenue lors de l'ouverture de la présentation: " & Err.Description, vbCritical
     On Error Resume Next
     AppPPT.Quit
     Set AppPPT = Nothing
     Set Prés = Nothing
     Set Diapo = Nothing
     Set DC = Nothing

End Sub

Bon je pense avoir fait le tour !
(En bonus il y a une macro exemple pour créer une présentation avec des diapos nommées)
Fichiers joints :
Evaluation Stage & Mise à Jour Présentation PPT.xlsm le fichier Excel contenant la macro et les évaluations
Macro de nommage des diapos.pptm le PPT contenant la macro de nommage des diapo
Présentation avec Diapos à nommer.pptx une présentation avec des diapo à nommer (pour tester)
ppt5E35 testé.pptm une présentation avec 3 diapos nommées pour tester la macro Excel

À bientôt

 

[melltel]

Merci pour tout @AtTheOne !