在Powerpoint VBA中获取形状索引

Question

我希望这是一个非常简单的问题，但由于某种原因我无法弄清楚。

我需要使用VBA删除PowerPoint幻灯片上所选形状的子集。 我可以使用：

ActivePresentation.Slides(1).Shapes.Range(_Index_).Delete

其中_Index_是形状索引（整数）或形状名称（sting）的数组。

由于形状名称不是唯一的（并且我正在制作此宏的人习惯于具有多个具有相同名称的形状，因此我需要依赖形状索引号）。 我的问题是我不知道如何获取给定形状的索引号。

我只能使用以下方法查看形状名称或形状ID：

ActiveWindow.Selection.ShapeRange(IdNum).Name
ActiveWindow.Selection.ShapeRange(IdNum).ID

所以我的问题是：如何获得选定形状的形状指数？

Answer 1

对一组形状进行分组时，该组将成为附加到前一个z顺序位置末尾的新形状。 在组形状本身之后，组中的所有单个形状都将附加到z顺序。

我找不到确定选择组中哪个项目的方法（子选择，我想应该说，因为原始父组保持选中状态，这就是查询ActiveWindow.Selection.ShapeRange（1时PPT返回的结果） ）。

要标识组中当前被子选择的项目，可以将其用作起点：

Sub WorkWithSubSelectedShapes()
' Do stuff with sub-selected shapes within a group
' Courtesy of Andy Pope

    Dim oSh As Shape
    Dim oGSh As Shape
    Dim x As Long

    Set oSh = ActiveWindow.Selection.ShapeRange(1)

    ' Do something with each shape in the group:
    For Each oGSh In oSh.GroupItems
        Debug.Print oGSh.TextFrame.TextRange.Text
    Next

    ' Now do something with each SUB-SELECTED
    ' shape within the group
    With ActiveWindow.Selection.ChildShapeRange
        For x = 1 To .Count
            Debug.Print .Item(x).Name
            Debug.Print .Item(x).TextFrame.TextRange.Text
        Next
    End With

End Sub

这是一些代码，通常可以帮助处理形状/组。 考虑到以下事实：组内可能存在组（组内（组内））...

Sub ProcessShapes()

    Dim oSh As Shape

    For Each oSh In ActivePresentation.Slides(1).Shapes
        If oSh.Type = msoGroup Then
            Debug.Print "GROUP" & vbTab & oSh.Name & vbTab & oSh.ZOrderPosition

            Call DealWithGroup(oSh)
        Else
            Debug.Print oSh.Name & vbTab & oSh.ZOrderPosition
        End If
    Next

End Sub

Sub DealWithGroup(oSh As Shape)
    Dim x As Long
    For x = 1 To oSh.GroupItems.Count
        If oSh.GroupItems(x).Type = msoGroup Then
            Call DealWithGroup(oSh.GroupItems(x))
        Else
            Debug.Print "GROUP ITEM" & vbTab & oSh.GroupItems(x).Name & vbTab & oSh.GroupItems(x).ZOrderPosition
        End If
    Next
End Sub

为了回答Peter的其他（优秀）问题，这应该可行：

Sub TestIndexOf()
    MsgBox IndexOf(ActiveWindow.Selection.ShapeRange(1))
End Sub

Function IndexOf(oSh As Shape) As Long

    Dim x As Long

    With ActiveWindow.Selection.SlideRange.Shapes
        For x = 1 To .Count
            If .Item(x).Name = oSh.Name Then
                ' Found it, report it
                IndexOf = x
            End If
        Next
    End With
End Function

Answer 2

尝试几行代码，然后您将在即时窗口中获得所有形状的名称（使用Cttl + G查看即时窗口）

Dim shp As Shape, I As Integer
For Each shp In ActivePresentation.Slides(1).Shapes
I = I + 1
Debug.Print "Index=" & I & " Name= " & shp.Name & " ID= " & shp.Id & " Type= " & shp.Type
Next