I found code to make Powerpoint VBA Harvey balls
I changed the last line to CommandBars.ExecuteMso ("ObjectsGroup")
instead of CommandBars.ExecuteMso ("ShapesCombine")
.
The first run of macro went fine, but when I run again (the first Harvey ball was on slide) I had the error
Shapes (unknow member): Integer out of range. [#]is not in the valid range of [#] to [#]
on the line Set oshpR = sld.Shapes.Range(Array(shp1.ZOrderPosition, shp2.ZOrderPosition))
If the shapes combined into one - there is no error. It appears with the group set only. I need this shapes as the group set on one slide. There could be multiple sets on the slide.
I assume it could be a problem, because it can be a lot of other group sets (not Harvey balls) on the slide.
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
Grouping via CommandBars.ExecuteMso requires that the shapes to be grouped be selected. Creating a shaperange doesn't implicitly select the shapes in the range.
Try this instead:
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
You could also just select the shaperange you've defined:
Set oshpR = sld.Shapes.Range(Array(shp1.ZOrderPosition, shp2.ZOrderPosition))
oshpR.Select msoTrue
CommandBars.ExecuteMso ("ObjectsGroup")