Automatisation de date sur PowerPoint en VBA

Bonjour , j 'ai trouvé un code afin de modifier une seule fois la date dans un cellule mais j'aimerai pouvoir avoir quand j'ouvre ou je ferme une box qui me demande la date voulu et qui mette à jour différentes zones "date" ainsi qu'avoir un bouton pour mettre à jour tout les graph en un clic (je suis obligé de sélectionner un graph et de faire actualisé les données après)

Sub copie_date()

With ActivePresentation

.Slides(2).Shapes("Date").Copy

.Slides(7).Shapes.Paste

End With

End Sub

'code qui reprend une cellule (mais ne supprime pas le précédent)

'le diaporama a été modifié de base il y a 8 graphique

Sub copie_date()

With ActivePresentation

.Slides(3).Shapes("date").Copy

.Slides(4).Shapes.Paste

.Slides(5).Shapes.Paste

.Slides(6).Shapes.Paste

.Slides(8).Shapes.Paste

End With

End SubSub copie_date()

With ActivePresentation

.Slides(2).Shapes("Date").Copy

.Slides(7).Shapes.Paste

End With

End Sub

'code qui reprend une cellule (mais ne supprime pas le précédent)

'le diaporama a été modifié de base il y a 8 graphique

Sub copie_date()

With ActivePresentation

.Slides(3).Shapes("date").Copy

.Slides(4).Shapes.Paste

.Slides(5).Shapes.Paste

.Slides(6).Shapes.Paste

.Slides(8).Shapes.Paste

End With

End Sub

Si vous avez des idées je suis preneur (c'est du code vba sur un fichier PowerPoint) j'ai mis en rouge les élément que j'aimerai automatiser

Edit Modo : mis code entre balises

Bonjour,

Sub TestMajShapesDates()
    MajShapesDates Date, 16, 18
End Sub

Sub MajShapesDates(ByVal MaDate As Date, ByVal Sem1 As Integer, ByVal Sem2 As Integer)

Dim MaPresentation As Presentation

    Set MaPresentation = ActivePresentation
    With MaPresentation
         .Slides(1).Shapes("TextBox 26").TextFrame2.TextRange.Text = Format(Date, "dd mmmm yyyy")
         .Slides(2).Shapes("Date").TextFrame2.TextRange.Text = Format(Date, "dd mmmm yyyy") & " - Suivi contrats provisoires"
         .Slides(3).Shapes("Date").TextFrame2.TextRange.Text = Format(Date, "dd mmmm yyyy") & " - Suivi contrats provisoires"
         .Slides(3).Shapes("Rounded Rectangle 12").TextFrame2.TextRange.Text = "XXXXX SEMAINE " & Sem1 & " XXXXXXXXXXXXXXXXXXXX SEMAINE " & Sem2
         .Slides(4).Shapes("Date").TextFrame2.TextRange.Text = Format(Date, "dd mmmm yyyy") & " - Suivi contrats provisoires"
    End With

    Set MaPresentation = Nothing

End Sub

Correction :

Sub TestMajShapesDates()

    MajShapesDates CDate("31/05/2023"), 16, 18

End Sub

Sub MajShapesDates(ByVal MaDate As Date, ByVal Sem1 As Integer, ByVal Sem2 As Integer)

Dim MaPresentation As Presentation

    Set MaPresentation = ActivePresentation
    With MaPresentation
         .Slides(1).Shapes("TextBox 26").TextFrame2.TextRange.Text = Format(MaDate, "dd mmmm yyyy")
         .Slides(2).Shapes("Date").TextFrame2.TextRange.Text = Format(MaDate, "dd mmmm yyyy") & " - Suivi contrats provisoires"
         .Slides(3).Shapes("Date").TextFrame2.TextRange.Text = Format(MaDate, "dd mmmm yyyy") & " - Suivi contrats provisoires"
         .Slides(3).Shapes("Rounded Rectangle 12").TextFrame2.TextRange.Text = "XXXXX SEMAINE " & Sem1 & " XXXXXXXXXXXXXXXXXXXX SEMAINE " & Sem2
         .Slides(4).Shapes("Date").TextFrame2.TextRange.Text = Format(MaDate, "dd mmmm yyyy") & " - Suivi contrats provisoires"
    End With

    Set MaPresentation = Nothing

End Sub

Bonjour Eric Kergresse,

Je te remercie le code fonctionne pour la partie des différentes dates avec succès néanmoins la partie sur du rectangle avec le texte à trou ne fonctionne pas (je me demande j'ai coller en format image d'excel à Powerpoint ça aurait une incidence ? )

Pour le CDate c'est automatique ? on peut gérer les formats ( si je veux 31 mai 2023 ou 31/05/2023 ? )

Et je voudrais mettre tout ce code dans un msg box se déclenchant à l'ouverture du PowerPoint afin de savoir si on met la date à jour ou pas c'est faisable ?

Sub TestMajShapesDates()

    MajShapesDates CDate("31/05/2023"), 16, 18

End Sub
Private Sub Presentation_Open()
Dim Response As Integer
Response = MsgBox("Voulez-vous mettre à jour les dates automatiquement?", vbYesNo, "Mise à jour des dates")
If Response = vbYes Then
    Sub MajShapesDates(ByVal MaDate As Date, ByVal Sem1 As Integer, ByVal Sem2 As Integer)
    Dim MaPresentation As Presentation

        Set MaPresentation = ActivePresentation
        With MaPresentation
            .Slides(1).Shapes("Date_Diapo1").TextFrame2.TextRange.Text = Format(MaDate, "dd mmmm yyyy")

            .Slides(2).Shapes("Date").TextFrame2.TextRange.Text = Format(MaDate, "dd mmmm yyyy") & " - Suivi contrats provisoires"

            .Slides(3).Shapes("Date").TextFrame2.TextRange.Text = Format(MaDate, "dd mmmm yyyy") & " - Suivi contrats provisoires"

            .Slides(4).Shapes("Date").TextFrame2.TextRange.Text = Format(MaDate, "dd mmmm yyyy") & " - Suivi contrats provisoires"
           ####### .Slides(4).Shapes("Image 15").TextFrame2.TextRange.Text = "Clé de lecture : XXXX des contrats provisoires créés sur la semaine " & Sem1 & " sont concrétisés à la fin de la semaine " & Sem2######

            .Slides(5).Shapes("Date").TextFrame2.TextRange.Text = Format(MaDate, "dd mmmm yyyy") & " - Suivi contrats provisoires"

            .Slides(6).Shapes("Date").TextFrame2.TextRange.Text = Format(MaDate, "dd mmmm yyyy") & " - Suivi contrats provisoires"

            .Slides(7).Shapes("Date").TextFrame2.TextRange.Text = Format(MaDate, "dd mmmm yyyy") & " - Suivi contrats provisoires"

            .Slides(8).Shapes("Date").TextFrame2.TextRange.Text = Format(MaDate, "dd mmmm yyyy") & " - Suivi contrats provisoires"

        End With

        Set MaPresentation = Nothing
    End Sub

Voici le code actuel, la ligne sur les semaines je n'arrive pas à la faire marcher et serais t-il possible de rentrer la date voulu (le CDate dans le msgBox?)

Et je ne comprends pas pourquoi le code actuel marche par exemple pour Avril , Mai , Juillet mais il ne marche pas pour JUIN

Dans le fichier joint, cliquez sur le bouton vert au bout de la barre d'accès rapide.

Bonjour, merci beaucoup le code fonctionne une dernière question c'est pour savoir comment avoir le bouton sur la barre d'accès rapide ?

Le fichier joint décrit le mode opératoire pour lancer une macro depuis la barre d'accès rapide.