使用VBA在PPT中重命名组对象

下面的代码不包含.GroupItems任何人都可以解决这个问题吗？使用VBA在PPT中重命名组对象

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

来源

2017-07-24 Lalit k

这是恐怕从一开始就注定了，除非你确定每个幻灯片上只有一种形式的每种类型。你不能给两个形状相同的名字。 –

由于您的评论已经指出，可以通过使用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

希望这有助于！

来源

2017-07-24 14:11:39 Domenic

它很好，但它不会在“群组”组你能帮忙吗？ –

在这种情况下，请使用David的解决方案。 – Domenic

尝试使用递归，因为分组形状只是形状对象的另一个（可迭代的）集合。

我修改了主程序，只是将整个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

来源

2017-07-24 14:23:15

只是想指出一个错字。被调用的sub的名字应该是SetShapeNames（带有s）。 – Domenic

@Domenic我会修复它，但你更欢迎使用[编辑]（https://stackoverflow.com/posts/45283073/edit）按钮来修复明显的错别字（或其他错误）在未来的答案:) –

谢谢，我将在未来做到这一点。 – Domenic

使用VBA在PPT中重命名组对象

回答

相关问题