Ajouter une numérotation auto au sein même d'une diapositive
Bruno83200_6929 Messages postés 725 Date d'inscription Statut Membre Dernière intervention -
Bonjour,
Est il possible via une macro ou une autre fonction disponible sur power point, de créer une numérotation automatique au sein même d'une diapositive ?
Je souhaiterais qu'à chaque retour à la ligne ou à chaque nouvelle zone de texte une numérotation automatique s'implémente sous le format "RG000".
Exemple :
RG001 : Règle 1
RG002 : Règle2
RG003 : Règle 3
Il faudrait que cette numérotation se poursuivre sur les slides suivantes.
Merci d'avance pour vos retours car je sèche sur ce point :/
Windows / Chrome 128.0.0.0
1 réponse
-
Bonjour,
Oui, c'est réalisable en créant une macro.
Dans l'éditeur VBA, cliquez sur Insert > Module pour ajouter un nouveau module.
Collez le code suivant :
Sub AjouterNumerotation() Dim diapo As Slide Dim shape As shape Dim compteur As Integer Dim prefix As String Dim zoneDeTexte As shape Dim nouvelleLigne As String Dim texteActuel As String ' Initialisation du compteur compteur = 1 prefix = "RG" ' Boucle à travers chaque diapositive de la présentation For Each diapo In ActivePresentation.Slides ' Boucle à travers chaque forme (shape) de la diapositive For Each shape In diapo.Shapes ' Vérifie si la forme est une zone de texte If shape.HasTextFrame Then If shape.TextFrame.HasText Then ' Sépare chaque paragraphe (ligne) dans la zone de texte For i = 1 To shape.TextFrame.TextRange.Paragraphs.Count ' Récupère le texte actuel du paragraphe texteActuel = shape.TextFrame.TextRange.Paragraphs(i).Text ' Formate la nouvelle ligne avec la numérotation automatique nouvelleLigne = prefix & Format(compteur, "000") & " : " & texteActuel ' Remplace l'ancien texte par le nouveau texte numéroté shape.TextFrame.TextRange.Paragraphs(i).Text = nouvelleLigne ' Incrémenter le compteur compteur = compteur + 1 Next i End If End If Next shape Next diapo End SubAprès avoir collé le code, vous pouvez exécuter la macro en appuyant sur F5 dans l'éditeur VBA ou en retournant dans PowerPoint et en allant dans Outils > Macro > Macro…, puis sélectionnez AjouterNumerotation.
Je pense que cela devrait fonctionner.
-
-
Bruno, la macro fonctionne ! Mais elle ne répond finalement pas à mon besoin.
Pour être plus efficace et pour éviter d'impacter les zones de titre et de bas de page, je songe à ajouter "RG000" à la Mano devant mes zones de texte. Il me faudrait pouvoir lancer une macro qui remplace les RG000 par la numérotation (RG001, RG002, RG003, etc.).
A l'inverse il me serait utile, si jamais le document vient à bouger après le lancement de cette macro, d'avoir une autre macro permettant de remplacer toutes les numérotations par "RG000". Ce qui me permettrait de relancer la macro initiale. Savez vous si s'est envisageable ? Avez vous une idée du code à coller dans l'éditeur VBA ?
-
-
Me voilà de nouveau. Je vous adresse trois nouvelles macros. AjouterRG000SansIncrementation() qui va vous permettre de remettre le PPS que vous avez modifié uniquement avec des RG000. Une seconde NumeroterRG000() qui va permettre de renuméroter tous les RG rencontrés. Et une troisième RemettreEnRG000() tous les RG d'un PPS.
Il faut donc modifier le code pour insérer uniquement des RG000 partout avec une nouvelle macro comme ceci :
Sub AjouterRG000SansIncrementation() Dim diapo As Slide Dim shape As shape Dim zoneDeTexte As shape Dim nouvelleLigne As String Dim texteActuel As String ' Préfixe constant "RG000" Dim prefix As String prefix = "RG000" ' Boucle à travers chaque diapositive de la présentation For Each diapo In ActivePresentation.Slides ' Boucle à travers chaque forme (shape) de la diapositive For Each shape In diapo.Shapes ' Vérifie si la forme est une zone de texte If shape.HasTextFrame Then If shape.TextFrame.HasText Then ' Sépare chaque paragraphe (ligne) dans la zone de texte For i = 1 To shape.TextFrame.TextRange.Paragraphs.Count ' Récupère le texte actuel du paragraphe texteActuel = shape.TextFrame.TextRange.Paragraphs(i).Text ' Formate la nouvelle ligne avec "RG000" nouvelleLigne = prefix & " : " & texteActuel ' Remplace l'ancien texte par le nouveau texte avec "RG000" shape.TextFrame.TextRange.Paragraphs(i).Text = nouvelleLigne Next i End If End If Next shape Next diapo End Sub -
Ensuite, il suffit de réécrire une macro pour remplacer tous les RG000 rencontré dans le document, et les numérotant de RG001 à ...
Sub NumeroterRG000() Dim diapo As Slide Dim shape As shape Dim compteur As Integer Dim prefix As String Dim texteActuel As String ' Initialisation du compteur compteur = 1 prefix = "RG" ' Boucle à travers chaque diapositive de la présentation For Each diapo In ActivePresentation.Slides ' Boucle à travers chaque forme (shape) de la diapositive For Each shape In diapo.Shapes ' Vérifie si la forme est une zone de texte If shape.HasTextFrame Then If shape.TextFrame.HasText Then ' Récupère le texte entier dans la zone de texte texteActuel = shape.TextFrame.TextRange.Text ' Remplace toutes les occurrences de "RG000" par "RGXXX" (numérotation incrémentée) If InStr(texteActuel, "RG000") > 0 Then shape.TextFrame.TextRange.Text = Replace(texteActuel, "RG000", prefix & Format(compteur, "000"), 1, -1) ' Incrémenter le compteur après chaque remplacement compteur = compteur + 1 End If End If End If Next shape Next diapo End Sub
-
