XL 2016 Filtre automatiquement avec VBA excel et powerpoint

melltel · 23 Juillet 2024

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 · 29 Juillet 2024

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 · 23 Juillet 2024

Bonjour à toutes & à tous, bonjour @melltel
La formule a utilisé dans excel est :

VB:

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

(101 pour la moyenne des lignes filtrées)
cette formule peut être affichée dans la ligne "total" du tableau ou ailleurs dans le classeur, la moyenne calculée sera celle des lignes visibles
voir fichier joint
A bientôt

melltel · 23 Juillet 2024

AtTheOne à dit:
Bonjour à toutes & à tous, bonjour @melltel
La formule a utilisé dans excel est :

VB:

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

(101 pour la moyenne des lignes filtrées)
cette formule peut être affichée dans la ligne "total" du tableau ou ailleurs dans le classeur, la moyenne calculée sera celle des lignes visibles
voir fichier joint
A bientôt

Merci pour ton retour AtTheOne, mais je ne me retrouve pas avec ta solution et le fichier moyenne filtrée semble vide au niveau du code vba.
S'il te plait peux tu reformuler ? Merci

AtTheOne · 23 Juillet 2024

Re,
Où est ton code VBA ??? Ton fichier excel est un xlsx et ne comporte donc pas de code !
As-tu fait des essais avec le fichier que je t'ai transmis dans le post#2 ? (moyenne filtrée.xlsx)
A bientôt

melltel · 24 Juillet 2024

AtTheOne à dit:
Re,
Où est ton code VBA ??? Ton fichier excel est un xlsx et ne comporte donc pas de code !
As-tu fait des essais avec le fichier que je t'ai transmis dans le post#2 ? (moyenne filtrée.xlsx)
A bientôt

Bonjour AtTheOne,
Oui j'ai fais un test avec le fichier que tu m'as transmit et les filtres marchent très bien mais je n'arrive pas à l'associer a mon code vba que voici:

Sub ExporterVersPPT()

Dim ws As Worksheet
Dim lastRow As Long
Dim sumNotes As Double
Dim countNotes As Long
Dim moyenne As Double
Dim PPApp As Object
Dim PPTPrésentation As Object
Dim slide As Object
Dim slideIndex As Integer
Dim codeStart As String
Dim cell As Range

' Définir la feuille de calcul
Set ws = ThisWorkbook.Sheets("EvaluationCampus")

' Ouvrir PowerPoint s'il n'est pas déjà ouvert
On Error Resume Next
Set PPApp = GetObject(, "PowerPoint.Application")
On Error GoTo 0
If PPApp Is Nothing Then
Set PPApp = CreateObject("PowerPoint.Application")
End If
PPApp.Visible = True

' Ouvrir la présentation PowerPoint existante ou créer une nouvelle présentation
On Error Resume Next
Set PPTPrésentation = PPApp.Presentations("ppt5E35 (2).pptx")
On Error GoTo 0
If PPTPrésentation Is Nothing Then
Set PPTPrésentation = PPApp.Presentations.Open(ThisWorkbook.Path & "\ppt5E35 (2).pptx")
End If

' Boucle pour chaque diapositive pour enlever les pieds de page
For Each slide In PPTPrésentation.Slides
For Each Shape In slide.Shapes
If Shape.Type = msoPlaceholder Then
If Shape.PlaceholderFormat.Type = ppPlaceholderFooter Then
Shape.Delete
End If
End If
Next Shape
Next slide

' Trouver la dernière ligne avec des données dans la colonne C
lastRow = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row

' Parcourir chaque code start unique
For Each cell In ws.Range("C2:C" & lastRow).SpecialCells(xlCellTypeConstants).Cells
codeStart = cell.Value

' Filtrer les données par le code start
ws.Range("A1:C" & lastRow).AutoFilter Field:=3, Criteria1:=codeStart

' Calculer la moyenne des notes filtrées dans la colonne A
sumNotes = Application.WorksheetFunction.Sum(ws.Range("A2:A" & lastRow).SpecialCells(xlCellTypeVisible))
countNotes = Application.WorksheetFunction.Count(ws.Range("A2:A" & lastRow).SpecialCells(xlCellTypeVisible))
If countNotes > 0 Then
moyenne = sumNotes / countNotes
Else
moyenne = 0
End If

' Insérer la moyenne dans la diapositive correspondante
slideIndex = GetSlideIndexByCodeStart(PPTPrésentation, codeStart)
If slideIndex > 0 Then
With PPTPrésentation.Slides(slideIndex).Shapes("RectangleNoteMoy").TextFrame.TextRange
.Text = Format(moyenne, "0.00")
.Font.Bold = msoTrue
.Font.Color = RGB(0, 112, 192) ' Bleu
.ParagraphFormat.Alignment = 1 ' Alignement à gauche
.Font.Size = 28 ' Ajuster la taille de la police
End With
End If

' Réinitialiser le filtre
ws.AutoFilterMode = False
Next cell

' Enregistrer la mise à jour
PPTPrésentation.Save

MsgBox "La présentation PowerPoint a été mise à jour.", vbInformation, "Avis sur la Formation"

End Sub

Function GetSlideIndexByCodeStart(presentation As Object, codeStart As String) As Integer
' Fonction pour obtenir l'index de la diapositive correspondant au code start
Dim slide As Object
For Each slide In presentation.Slides
If slide.Shapes.HasTitle Then
If slide.Shapes.Title.TextFrame.TextRange.Text = codeStart Then
GetSlideIndexByCodeStart = slide.slideIndex
Exit Function
End If
End If
Next slide
GetSlideIndexByCodeStart = -1 ' Retourne -1 si aucun slide ne correspond
End Function

AtTheOne · 24 Juillet 2024

Bonjour à toutes et à tous, bonjour @melltel
Bon je n'ai pas repris ton code, ni l'utilisation de filtres ni l'utilisation de la fonction sous-total pour te faire un exemple.
J'ai renommé ton tableau structuré, j'en ai ajouté un dans la feuille "Tables" contentant la liste des "Code START"

Si les "Code START" à filtrer sont nombreux, il vaut mieux passer par des tableaux VBA et calculer les moyennes.

Dans l'exemple que je te donne, je crée une nouvelle présentation avec une diapo par "Code START" contenant 2 textes, l'un pour le "Code START"l'autre pour la moyenne.
Remarque que je nomme les Diapos et les Shapes pour faciliter leur accès par VBA a posteriori.
J'ai commenté la macro, je pense que tu devrais savoir adapter cela à ton code.
Le Code :

Code:

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

Voir le fichier joint

A bientôt

melltel · 24 Juillet 2024

AtTheOne à dit:

Bonjour à toutes et à tous, bonjour @melltel
Bon je n'ai pas repris ton code, ni l'utilisation de filtres ni l'utilisation de la fonction sous-total pour te faire un exemple.
J'ai renommé ton tableau structuré, j'en ai ajouté un dans la feuille "Tables" contentant la liste des "Code START"

Si les "Code START" à filtrer sont nombreux, il vaut mieux passer par des tableaux VBA et calculer les moyennes.

Dans l'exemple que je te donne, je crée une nouvelle présentation avec une diapo par "Code START" contenant 2 textes, l'un pour le "Code START"l'autre pour la moyenne.
Remarque que je nomme les Diapos et les Shapes pour faciliter leur accès par VBA a posteriori.
J'ai commenté la macro, je pense que tu devrais savoir adapter cela à ton code.
Le Code :

Code:

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

Voir le fichier joint

A bientôt

Merci @AtTheOne, je vais l'adapter avec mon travail et te confirmer si ca marche ou pas.
Merci

AtTheOne · 24 Juillet 2024

Re
A tout hasard une macro PowerPoint pour nommer les Diapositives (propriété Name) une par une :

VB:

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

Une fois nommées les diapos sont accessibles grâce à ce nom :
Dim Sld as Slide
Set Sld = ActivePresentation.slides("Nom donné à la diapo")

A bientôt

melltel · 25 Juillet 2024

AtTheOne à dit:

Re
A tout hasard une macro PowerPoint pour nommer les Diapositives (propriété Name) une par une :

VB:

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

Une fois nommées les diapos sont accessibles grâce à ce nom :
Dim Sld as Slide
Set Sld = ActivePresentation.slides("Nom donné à la diapo")

A bientôt

Merci @AtTheOne
Ca me parait plus complexe que j'avais imaginé et je ne suis pas très sure que j'ai été bien explicite. Donc je vais réexpliquer ma demande avec ce que vous m'avez proposer et ce que j'ai pu modifier

Grace au tableau filtré, je souhaite:
-Afficher la moyenne filtrée du tableau excel (B410 ) dans la zone ou se trouve la note du fichier powerpoint (RectangleNoteMoy)
-respectant la condition selon laquelle: si le Code START filtré est égal à D16_D16S_223B (un exemple) et la selection powerpoint D16_D16S_223B (le cadre) est égal à D16_D16S_223B, on affiche la moyenne filtré dans l'espace : RectangleNoteMoy
Je l'ai illustré dans mon code et j'ai une erreur au niveau de la déclaration du fichier power point

je joins ici mes 2 fichiers.

Un Grand Merci pour ton aide

AtTheOne · 25 Juillet 2024

Bonjour à toutes & à tous, bonjour @melltel
Je crois que j'ai bien compris ton besoin, je pense qu'il faut lancer une macro à partir d'excel qui modifie ton fichier Powerpoint.
Je regarderai ce soir.
À bientôt

AtTheOne · 25 Juillet 2024

Bonsoir

AtTheOne à dit:
Je regarderai ce soir.

Rentré trop tard, on voit ça demain

AtTheOne · 26 Juillet 2024

Bonjour à toutes & à tous, bonjour @melltel

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.

Remarques :

le Code START "D16_D16S_230" n'existe pas dans les évaluations (il y a des suffixes pour ce code : aG, oC, oG, oP )
le séparateur pour ces suffixes était dans la présentation un "-" et dans les évaluations un "_",
j'ai homogénéisé en choisissant le "-" car dans la présentation je n'avais pas accès au texte, mais tu peux faire à ta façon.

Quand le Code START n'existe pas dans les évaluations, le rectangle contenant la moyenne reste inchangé. (cas du code D16_D16S_230)

J'utilise un Dictionnaire pour collecter les moyennes, cela me permet quand la diapo porte le nom d'un Code START d'affecter directement au rectangle "Moy_Code_START", s'il existe, la moyenne calculée par la macro.

Voilà, la présentation ne doit pas être ouverte lorsque tu lances la macro Excel, c'est elle qui l'ouvre, la modifie, l'enregistre puis la ferme.
Macro Excel

VB:

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

Macro PowerPoint pour nommer les diapos

VB:

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

En pièce jointe
la présentation modifiée (sans moyenne pour que tu puisse voir les changements apportés par la macro Excel lorsque tu l'exécuteras)
le fichier Excel
Bon courage et à bientôt

AtTheOne · 26 Juillet 2024

Re,
Les fichiers que je t'ai envoyés ne sont pas protégés, par contre quand tu les télécharges, ils sont bloqués par Windows, tu dois cocher dans les propriétés "Débloquer" :

Puis

Fais cela pour les deux fichiers

Il faut aussi que tu autorises les macros dans les options d'Excel et de PowerPoint
Pour PowerPoint (V2021)

Pour excel (V2021)

À bientôt

melltel · 26 Juillet 2024

D'accord merci ❣️je teste tout ca

melltel · 29 Juillet 2024

Bonjour a tous, Bonjour @AtTheOne
Désolé de revenir vers toi.
J'ai tout bien testé le code, mais j'ai eu cette 1ère erreur

Pour ca, j'ai renommé les plages de cellule tb_CodeSTART et tb_Eval sur mon tableau excel mais cette fois j'ai une autre erreur que je n'arrive pas a ressoudre :

Stp as tu une piste ?
Merci

XL 2016 Filtre automatiquement avec VBA excel et powerpoint

melltel

XLDnaute Occasionnel

Pièces jointes

AtTheOne

AtTheOne

XLDnaute Accro

Pièces jointes

melltel

XLDnaute Occasionnel

AtTheOne

XLDnaute Accro

melltel

XLDnaute Occasionnel

AtTheOne

XLDnaute Accro

Pièces jointes

melltel

XLDnaute Occasionnel

AtTheOne

XLDnaute Accro

melltel

XLDnaute Occasionnel

Pièces jointes

AtTheOne

XLDnaute Accro

AtTheOne

XLDnaute Accro

AtTheOne

XLDnaute Accro

Pièces jointes

AtTheOne

XLDnaute Accro

melltel

XLDnaute Occasionnel

melltel

XLDnaute Occasionnel

Discussions similaires

XL 2016 Filtre automatiquement avec VBA excel et powerpoint

XLDnaute Occasionnel

Pièces jointes

XLDnaute Accro

Pièces jointes

XLDnaute Occasionnel

XLDnaute Accro

XLDnaute Occasionnel

XLDnaute Accro

Pièces jointes

XLDnaute Occasionnel

XLDnaute Accro

XLDnaute Occasionnel

Pièces jointes

XLDnaute Accro

XLDnaute Accro

XLDnaute Accro

Pièces jointes

XLDnaute Accro

XLDnaute Occasionnel

XLDnaute Occasionnel

Discussions similaires

Privacy & Transparency

Privacy & Transparency