使用VBA在PPT中重命名組對象

Question

下面的代碼不包含.GroupItems任何人都可以解決這個問題嗎？

Public Sub RenameOnSlideObjects() 
     Dim oSld As Slide 
     Dim oShp As Shape 
     For Each oSld In ActivePresentation.Slides 
     For Each oShp In oSld.Shapes 
      With oShp 
      Select Case True 
       Case .Type = msoPlaceholder ' you could then check the placeholder type too 
       .Name = "myPlaceholder" 
       Case .Type = msoTextBox 
       .Name = "myTextBox" 
       Case .Type = msoAutoShape 
       .Name = "myShape" 
       Case .Type = msoChart 
       .Name = "myChart" 
       Case .Type = msoTable 
       .Name = "myTable" 
       Case .Type = msoPicture 
       .Name = "myPicture" 
       Case .Type = msoSmartArt 
       .Name = "mySmartArt" 
       Case .Type = msoGroup ' you could then cycle though each shape in the group 
       .Name = "myGroup" 
      Case Else 
       .Name = "Unspecified Object" 
      End Select 
      End With 
     Next 
     Next 
    End Sub 

來源：https://stackoverflow.com/a/34016348/8357374

Answer 1

由於您的評論已經指出，可以通過使用Shape對象的GroupItems屬性中的每個形狀/組項循環...

Public Sub RenameOnSlideObjects() 
     Dim oSld As Slide 
     Dim oShp As Shape 
     Dim oGrpItm As Shape 
     Dim GrpItmNum As Integer 
     For Each oSld In ActivePresentation.Slides 
     For Each oShp In oSld.Shapes 
      With oShp 
      Select Case True 
       Case .Type = msoPlaceholder ' you could then check the placeholder type too 
       .Name = "myPlaceholder" 
       Case .Type = msoTextBox 
       .Name = "myTextBox" 
       Case .Type = msoAutoShape 
       .Name = "myShape" 
       Case .Type = msoChart 
       .Name = "myChart" 
       Case .Type = msoTable 
       .Name = "myTable" 
       Case .Type = msoPicture 
       .Name = "myPicture" 
       Case .Type = msoSmartArt 
       .Name = "mySmartArt" 
       Case .Type = msoGroup ' you could then cycle though each shape in the group 
       .Name = "myGroup" 
       GrpItmNum = 0 
       For Each oGrpItm In .GroupItems 
        GrpItmNum = GrpItmNum + 1 
        oGrpItm.Name = "myGroupItem" & GrpItmNum 
       Next oGrpItm 
      Case Else 
       .Name = "Unspecified Object" 
      End Select 
      End With 
     Next 
     Next 
    End Sub 

希望這有助於！

Answer 2

嘗試使用遞歸，因爲分組形狀只是形狀對象的另一個（可迭代的）集合。

我修改了主程序，只是將整個oSld.Shapes集合傳遞給名爲SetShapeNames的子例程。在這個子程序中，如果單個對象的類型爲msoGroup，那麼我們會針對該對象遞歸地調用該子例程。

注意：未經測試。

Public Sub RenameOnSlideObjects() 
Dim oSld As Slide 
For Each oSld In ActivePresentation.Slides 
    Call SetShapeNames(oSld.Shapes) 
Next 
End Sub 

Sub SetShapeNames(MyShapes) 
Dim oShp as Shape 
For Each oShp in MyShapes 
    With oShp 
     Select Case .Type 
      Case msoPlaceholder ' you could then check the placeholder type too 
       .Name = "myPlaceholder" 
      Case msoTextBox 
       .Name = "myTextBox" 
      Case msoAutoShape 
       .Name = "myShape" 
      Case msoChart 
       .Name = "myChart" 
      Case msoTable 
       .Name = "myTable" 
      Case msoPicture 
       .Name = "myPicture" 
      Case msoSmartArt 
       .Name = "mySmartArt" 
      Case msoGroup ' // call this function recursively 
       Call SetShapeNames(oShp.GroupItems) 
      Case Else 
       .Name = "Unspecified Object" 
     End Select 
    End With 
Next 
End Sub