VBA 将所有 PowerPoint 形状组重命名为文本框内容

Question

我有一个包含 1700 多张幻灯片的幻灯片。每张幻灯片上都有两张图像。每个图像下面还有一个带有唯一标识符的文本框。每个图像都与文本框分组。群组名称并不唯一。

因此，在所有幻灯片上，我都在选择窗格中：

---

第8组 长方形7 图7

第4组 长方形3 图2

---

矩形是包含UID的文本框。照片的替代文本还包括 UID。

我需要做的是使用文本框的内容（即我的 UID）以编程方式重命名“Group 8”和“Group 4”。通过 VBA 可以相当轻松地完成此任务吗？在选择窗格中重命名每个组名称将是一场噩梦。

任何有关可行性的想法都将不胜感激，或者也许我可以调整一些 VBA 来完成此任务。

我尝试过在选择窗格中手动重命名，但这不可行。

Answer 1

提供代码将用矩形上的文本更新组的名称。

如果您使用 TextBox（插入 >> TextBox），请根据需要更新代码。

姓名	价值	描述
msoAutoShap	1	自选图形
msoTextBox	17	文本框

请参考微软文档。

MsoShapeType 枚举（Office）

Sub UpdateGroupNames()
    Dim objPresentation As Object
    Dim objSlide As Object
    Dim objShape As Object
    Dim oShpInGrp As Object
    Set objPresentation = ActivePresentation
    For Each objSlide In objPresentation.Slides
        For Each objShape In objSlide.Shapes
'            Debug.Print objShape.Type
            If objShape.Type = 6 Then 'group shape
                Set objShape = objShape
                For Each oShpInGrp In objShape.GroupItems
                    If oShpInGrp.Type = 1 Then ' Rectangle (AutoShape)
                        objShape.Name = oShpInGrp.TextFrame.TextRange.Text
                        Exit For
                    End If
                Next oShpInGrp
            End If
        Next objShape
    Next objSlide
End Sub