Looking for a VBA or Addin for Auto numbering text box in slides

Question

enter image description hereFor educational purposes, I need a method or plugin that allows automatic textbox numbering. I ran into solutions on this site stating that such a sequence is possible from the PowerPoint interface, but unfortunately this is not enough to make my work flexible. For example, if I updated the first list by adding or deleting one of its elements, the numbering will not change in the second list, and this is a problem for me, because the presentation contains dozens of slides.

So is there any way VBA or some addin to auto numbering the list in text box in the slides? even if i take a copy of the text box? thanks alot to everyone who provides assistance

Answer 1

This is a simple example, the conditions is :

1. all the text in your textbox is numbered by paragraph
2. And the texts in all the slides are continuous, there is a change in the middle, or the numbering is renumbered, all of them will be updated synchronously( ie. renumber)
3. this code will renumber from the first to the last slide without missing any.

Sub AutoNumberBullets()
   Dim oSl As Slide
   Dim oSh As Shape
   Dim X As Long, Y As Long
   Dim nextStartValue As Long
   For Each oSl In ActivePresentation.Slides
      For Each oSh In oSl.Shapes
         If oSh.HasTextFrame And oSh.TextFrame.HasText Then
            With oSh.TextFrame.TextRange.ParagraphFormat
               'If .Bullet.Type = ppBulletNone Then
                  .Bullet.Type = ppBulletNumbered
'                  X = .Parent.IndentLevel
'                  Y = X + 1
'                  If Y > 5 Then Y = 5
'                  .Parent.IndentLevel = Y
                  With .Bullet
                        '.Type = ppBulletNumbered
                        .Style = ppBulletArabicPeriod
                        .StartValue = nextStartValue + 1 'VBA.IIf(nextStartValue = 0, 1, nextStartValue + 1)
                        nextStartValue = .Parent.Parent.Paragraphs(getParagraphsCount(.Parent.Parent.Text)).ParagraphFormat.Bullet.Number
                  End With
               'End If
            End With
         End If
      Next
   Next
End Sub

Function getParagraphsCount(txt As String) As Long
    Dim i As Long, s As Long
    s = 1
    s = InStr(s, txt, Chr(13))
    Do While s
        s = InStr(s + 1, txt, Chr(13))
        i = i + 1
    Loop
    getParagraphsCount = i + 1
End Function