Добавление или замена нумерации слайдов в заголовках выбранных слайдов

Question

Я хочу создать макрос, который добавит в конец нумерацию заголовков выбранных слайдов в формате (1/5).

Мне удалось написать эту часть с добавлением нумерации. Я не могу подготовить vba к поиску и замене существующей нумерации. Это необходимо, когда по какой-либо причине порядок слайдов будет изменен и нуждается в обновлении.

Sub SlideNumbering()

Dim shp As shape
Dim sld As Slide
Dim SldAll As Single
Dim SldNr As Single

SldAll = Application.ActiveWindow.Selection.SlideRange.Count

SldNr = SldAll

For s = SldAll To 1 Step -1
    ActivePresentation.Slides(s).Shapes.Title.TextFrame.TextRange.InsertAfter " (" & SldNr & "/" & SldAll & ")"
    SldNr = SldNr - 1
Next

End Sub

Answer 1

Вот макрос для удаления существующей нумерации. При этом используется шаблон регулярного выражения для поиска последовательности пробела, скобки, любого числа, обратной косой черты, любого числа и закрывающей скобки:

Sub DeleteNumbering()
  Dim regX As Object
  Dim oSlide As Slide
  Dim oShape As Shape
  Dim Foundb As Boolean
  Dim NewText$

  Set regX = CreateObject("vbscript.regexp")
  With regX
    .Global = True
    .Pattern = " \(\d(/)\d\)"
  End With
  ReplaceWord = ""

  For Each oSlide In ActivePresentation.Slides
    For Each oShape In oSlide.Shapes
      If oShape.Type = msoPlaceholder Then
        If (oShape.PlaceholderFormat.Type = ppPlaceholderCenterTitle _
        Or oShape.PlaceholderFormat.Type = ppPlaceholderTitle) _
        And oShape.TextFrame.HasText Then
          Foundb = regX.Test(oShape.TextFrame.TextRange.Text)
          If Foundb = True Then
            NewText$ = regX.Replace(oShape.TextFrame.TextRange.Text, "")
            oShape.TextFrame.TextRange.Text = NewText$
          End If
        End If
      End If
    Next oShape
  Next oSlide
End Sub