"ObjectsGroup" 错误 "Integer out of range"

Question

我找到了制作

的代码

我将最后一行更改为 CommandBars.ExecuteMso ("ObjectsGroup") 而不是 CommandBars.ExecuteMso ("ShapesCombine")。

宏的第一个运行正常，但是当我再次运行时（第一个哈维球在幻灯片上）我有错误

Shapes (unknow member): Integer out of range. [#]is not in the valid range of [#] to [#]

上线Set oshpR = sld.Shapes.Range(Array(shp1.ZOrderPosition, shp2.ZOrderPosition))

如果形状合二为一 - 没有错误。它仅与组集一起出现。我需要这个形状作为在一张幻灯片上设置的组。幻灯片上可以有多组。

我认为这可能是个问题，因为幻灯片上可能有很多其他组（不是 Harvey 球）。

Sub Test2()
    Dim sld As Slide
    Dim shp1 As Shape
    Dim shp2 As Shape
    Dim oshpR As ShapeRange

    Set sld = Application.ActiveWindow.View.Slide
    Set shp1 = ActivePresentation.Slides(1).Shapes.AddShape(msoShapeOval, 300, 100, 50, 50)
    Set shp2 = ActivePresentation.Slides(1).Shapes.AddShape(msoShapePie, 300, 100, 50, 50)
    Set oshpR = sld.Shapes.Range(Array(shp1.ZOrderPosition, shp2.ZOrderPosition))
    CommandBars.ExecuteMso ("ObjectsGroup") 
End Sub

Answer 1

通过 CommandBars.ExecuteMso 分组需要对要分组的形状进行 select 编辑。创建一个 shaperange 不会隐含 select 范围内的形状。

试试这个：

Sub Test2()
Dim sld As Slide
Dim shp1 As Shape
Dim shp2 As Shape
Dim oshpR As ShapeRange

Set sld = Application.ActiveWindow.View.Slide
Set shp1 = ActivePresentation.Slides(1).Shapes.AddShape(msoShapeOval, 300, 100, 50, 50)
Set shp2 = ActivePresentation.Slides(1).Shapes.AddShape(msoShapePie, 300, 100, 50, 50)
'Set oshpR = sld.Shapes.Range(Array(shp1.ZOrderPosition, shp2.ZOrderPosition))
' msoTrue forces a new selection
shp1.Select msoTrue
' msoFalse adds the shape to the current selection
shp2.Select msoFalse
CommandBars.ExecuteMso ("ObjectsGroup")
End Sub

您也可以 select 您定义的形状范围：

Set oshpR = sld.Shapes.Range(Array(shp1.ZOrderPosition, shp2.ZOrderPosition))
oshpR.Select msoTrue
CommandBars.ExecuteMso ("ObjectsGroup")

"ObjectsGroup" 错误 "Integer out of range"

"ObjectsGroup" error "Integer out of range"

powerpoint

vba