ShapesRange.Group 方法失败 - Powerpoint 的 VBA

Question

我正在尝试将幻灯片上的两个对象（矩形、椭圆形）分组 我收到“运行时错误 -2147467259 (80004005) Shapes.Range：失败”

简而言之，我循环浏览演示文稿的每张幻灯片，通过过滤掉占位符对象

Shape.type <> msoPlaceholder

其余形状收集在一个数组中

Dim ShpCollection as Variant
Dim i as integer, k as integer
i = 0
Redim ShpCollection(i)

For each Slide in PPT
    For each Shape in Slide
        if Shape.Type <> msoPlaceholder then
            Redim Preserve ShpCollection(i)
            ShpCollection(i) = Shape.Name
            i = i + 1
        end if
    Next Shape
    For k = 1 to 5000
        DoEvents 'to allow shapes to be 
    next k
    MSPowPnt.Presentations("PPTName.pptx").Slides(1).Shapes.Range(ShpCollection).Group  
    'MSPowPnt is a variable representing late binding of Powerpoint application
Next Slide

错误发生在 -

行

MSPowPnt.Presentations("PPTName.pptx").Slides(1).Shapes.Range(ShpCollection).Group*

奇怪的是，下面的方法有效 -

MSPowPnt.Presentations("PPTName.pptx").Slides(1).Shapes.Range(Array(ShpCollection(0),ShpCollection(1) ).Group*

我只是无法理解为什么引用元素数组可以，但数组变量却不行？

感谢任何帮助。

谢谢，

代表代码见上文

Answer 1

请尝试一下。

Sub GroupAllShapes()
    Dim ShpCollection As Variant
    Dim oSlide As Slide
    Dim i As Integer
    For Each oSlide In ActivePresentation.Slides
        i = 0
        ReDim ShpCollection(i)
        For Each Shape In oSlide.Shapes
            If Shape.Type <> msoPlaceholder Then
                ReDim Preserve ShpCollection(i)
                ShpCollection(i) = Shape.Name
                i = i + 1
            End If
        Next Shape
        oSlide.Shapes.Range(ShpCollection).Group
     Next oSlide
End Sub