Это подберет текст заголовка каждого слайда и добавит его на страницу заметок. Измените по мере необходимости, чтобы изменить форматирование текста / положение.
Sub AddTitlesToNotesPages() Dim oSld As Slide Dim oShp As Shape Dim sTitleText As String For Each oSld In ActivePresentation.Slides ' get the slide's title text sTitleText = GetTitleText(oSld) ' add a text shape with the text to notes page ' placement is totally arbitrary; edit to suit Set oShp = oSld.NotesPage.Shapes.AddTextbox(msoTextOrientationHorizontal, _ 0, 0, 500, 100) With oShp.TextFrame.TextRange .Text = sTitleText ' modify other stuff as needed .Font.Name = "Arial" .Font.Color.RGB = RGB(0, 0, 0) ' black ' and so on End With Next ' Slide End Sub Function GetTitleText(oSld As Slide) As String ' Returns the title text for oSld if any, or "Slide xxx" if not Dim oShp As Shape Dim sTemp As String For Each oShp In oSld.Shapes If oShp.Type = msoPlaceholder Then If oShp.PlaceholderFormat.Type = ppPlaceholderCenterTitle Or oShp.PlaceholderFormat.Type = ppPlaceholderTitle Then sTemp = oShp.TextFrame.TextRange.Text End If End If Next ' if we got this far and didn't find a slide title: If Len(sTemp) = 0 Then ' return the slide index number GetTitleText = "Slide " & CStr(oSld.SlideIndex) Else ' return the title GetTitleText = sTemp End If End Function