使用VBA循环为PowerPoint指定幻灯片批量插入标题及数组定义方法

你提供的原始代码仅通过硬编码数组适配了1-5号幻灯片，针对连续区间的批量标题添加需求，可通过以下两种方式实现：

• 逐张循环方案：兼容性最好，适配所有PowerPoint版本，是批量操作幻灯片的首选方案
• 动态数组构造方案：直接生成指定区间的幻灯片序号数组，传入Slides.Range()实现批量操作

逐张循环实现方案（推荐） #

该方案不需要手动枚举幻灯片序号，仅需修改起止索引即可适配任意连续范围的幻灯片，比如前10张、20-30张这类场景，直接修改常量值即可。
完整可运行代码如下：

Sub BatchAddSameTitle()
    Dim shpCurrShape As Shape
    Dim ppPres As Presentation
    Dim slideIdx As Long
    
    Set ppPres = ActivePresentation
    
    ' ====== 配置项：按需修改起止幻灯片序号即可 ======
    Const RANGE_START As Long = 1   ' 起始幻灯片序号，处理20-30张就改成20
    Const RANGE_END As Long = 10    ' 结束幻灯片序号，处理20-30张就改成30
    Const TITLE_TEXT As String = "请输入你的统一标题内容"
    ' ==============================================

    ' 逐张遍历目标幻灯片
    For slideIdx = RANGE_START To RANGE_END
        With ppPres.Slides(slideIdx)
            ' 无标题占位符则新建，已有则直接引用
            If Not .Shapes.HasTitle Then
                Set shpCurrShape = .Shapes.AddTitle
            Else
                Set shpCurrShape = .Shapes.Title
            End If

            ' 设置标题内容与样式
            With shpCurrShape.TextFrame.TextRange
                .Text = TITLE_TEXT
                .ParagraphFormat.Alignment = ppAlignLeft ' 值为1即左对齐，可按需替换为ppAlignCenter/ppAlignRight
                With .Font
                    .Bold = msoTrue
                    .Name = "Tw Cen MT"
                    .Size = 24
                    .Color = RGB(0, 0, 0)
                End With
            End With
        End With
    Next slideIdx
End Sub

动态构造幻灯片序号数组方案 #

如果需要直接通过Slides.Range()传入数组指代20-30张这类连续范围，不需要手动逐个写序号，可通过以下代码自动生成对应数组：

Sub GenerateSlideRangeArr()
    Dim ppPres As Presentation
    Dim shpCurrShape As Shape
    Dim targetArr() As Long
    Dim arrPos As Long, i As Long
    
    Set ppPres = ActivePresentation
    
    ' 构造20-30张幻灯片对应的序号数组
    ReDim targetArr(0 To 10) ' 20到30共11个元素，数组下标从0开始
    arrPos = 0
    For i = 20 To 30
        targetArr(arrPos) = i
        arrPos = arrPos + 1
    Next i

    ' 传入数组批量操作
    With ppPres.Slides.Range(targetArr)
        ' 此处标题配置逻辑和前述代码一致
        If Not .Shapes.HasTitle Then
            Set shpCurrShape = .Shapes.AddTitle
        Else
            Set shpCurrShape = .Shapes.Title
        End If
        With shpCurrShape.TextFrame.TextRange
            .Text = "统一标题内容"
            ' 其余字体、对齐配置可直接复用前述代码
        End With
    End With
End Sub

注意：部分低版本PowerPoint对跨幻灯片Range的形状属性同步支持不佳，可能出现标题样式/内容不生效的问题，优先选择逐张循环的方案稳定性更高。

内容的提问来源于stack exchange，提问作者Alejandro Gonzalez