Ajouter une numérotation auto au sein même d'une diapositive
Bruno83200_6929 Messages postés 627 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
- Ajouter une numérotation auto au sein même d'une diapositive
- Ajouter une application au démarrage - Guide
- Ajouter une signature sur word - Guide
- Ajouter une liste déroulante excel - Guide
- Ajouter une vidéo sur powerpoint - Guide
- Pourquoi je ne peux pas ajouter une personne sur facebook - Guide
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 Sub
Aprè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.
Merci Bruno pour votre retour. Je regarde ça rapidement et vous tiens au courant
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 ?
C'est réalisable, je vous demande un peu de temps pour réécrire les macros.
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 SubEnsuite, 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