使用VBA批量重命名PowerPoint形状组为文本框内容

该需求完全可行，通过PowerPoint VBA可以批量遍历所有幻灯片中的组，提取文本框内的UID并重命名组。以下是可调整的VBA代码及使用说明：

VBA代码 #

Sub RenameGroupsToUID()
    Dim sld As Slide
    Dim grpShape As Shape
    Dim innerShape As Shape
    Dim uidContent As String
    
    ' 遍历演示文稿中的每一张幻灯片
    For Each sld In ActivePresentation.Slides
        ' 遍历当前幻灯片上的所有形状
        For Each grpShape In sld.Shapes
            ' 判断当前形状是否为组
            If grpShape.Type = msoGroup Then
                uidContent = ""
                ' 遍历组内的所有子形状
                For Each innerShape In grpShape.GroupItems
                    ' 根据选择窗格中的命名特征匹配存储UID的文本框（此处匹配名称含"Rectangle"的形状）
                    If InStr(innerShape.Name, "Rectangle") > 0 Then
                        ' 提取文本框内的UID内容并去除首尾空白
                        uidContent = Trim(innerShape.TextFrame.TextRange.Text)
                        Exit For ' 找到目标文本框后退出内层循环
                    End If
                Next innerShape
                
                ' 仅当提取到有效UID时重命名组
                If uidContent <> "" Then
                    grpShape.Name = uidContent
                Else
                    ' 可选：在立即窗口输出未找到UID的组信息，方便排查
                    Debug.Print "幻灯片" & sld.SlideNumber & "上的组未找到有效UID"
                End If
            End If
        Next grpShape
    Next sld
    
    MsgBox "组重命名操作完成！", vbInformation
End Sub

代码调整说明 #

• 匹配文本框的规则：如果你的文本框在选择窗格中的名称不是以"Rectangle"开头，可修改InStr(innerShape.Name, "Rectangle") > 0这一条件，例如改为innerShape.Type = msoTextBox（匹配所有文本框类型），或根据实际名称特征调整字符串匹配逻辑。
• 错误处理：代码中已包含基础的空值判断，若某组内未找到目标文本框，会在VBA编辑器的立即窗口打印提示信息，不会中断整体执行。

使用步骤 #

1. 打开目标演示文稿，按下Alt + F11打开VBA编辑器；
2. 在左侧项目窗口中右键点击当前演示文稿，选择「插入」→「模块」；
3. 将上述代码粘贴到新建的模块中；
4. 点击工具栏中的「运行」按钮（或按F5）执行代码，等待弹窗提示完成。

内容的提问来源于stack exchange，提问作者Rahul Gill