问题
I'm trying to create some Harvey balls from VBA code in PowerPoint 2010+. For this, I'm inserting a circle shape and a pie one and combine them. Everything works fine if I'm inserting the two shapes from the ribbon and then align and combine them, but when I'm inserting the shapes from VBA, the result of combining them is completely different and I don't understand why.
So:
- insert shapes from ribbon -> align using ribbon -> combine using ribbon -> everything OK
- insert shapes from VBA -> align using ribbon -> combine using ribbon -> wrong result
You can see it in this video.
VBA code for inserting the shapes (very basic) below.
ActivePresentation.Slides(slide_num).Shapes.AddShape(msoShapeOval, 100, 100, 50, 50).Select
ActivePresentation.Slides(slide_num).Shapes.AddShape(msoShapePie, 200, 100, 50, 50).Select
Help, please!
回答1:
If absolute value of both adjustments of the pie (the yellow diamonds) are any of the following 0, 90, 180, 270 values then the combine behaves like a substract geometry operation. This looks like a bug in the Combine geometry. Instead, if you set to a value of 90.01 then you get the expected behavior.
Sub Test1()
Dim shp1 As Shape
Dim shp2 As Shape
Set shp1 = ActivePresentation.Slides(1).Shapes.AddShape(msoShapeOval, 100, 100, 50, 50)
Set shp2 = ActivePresentation.Slides(1).Shapes.AddShape(msoShapePie, 100, 100, 50, 50)
Call ActiveWindow.Selection.SlideRange(1).Shapes.Range(Array( shp1.ZOrderPosition, shp2.ZOrderPosition)).MergeShapes(msoMergeCombine)
End Sub
Sub Test2()
Dim shp1 As Shape
Dim shp2 As Shape
Set shp1 = ActivePresentation.Slides(1).Shapes.AddShape(msoShapeOval, 200, 100, 50, 50)
Set shp2 = ActivePresentation.Slides(1).Shapes.AddShape(msoShapePie, 200, 100, 50, 50)
shp2.Adjustments(1) = shp2.Adjustments(1) + 0.1
Call ActiveWindow.Selection.SlideRange(1).Shapes.Range(Array(shp1.ZOrderPosition, shp2.ZOrderPosition)).MergeShapes(msoMergeCombine)
End Sub
回答2:
My friend, you're a life saver!
Just a short comment, if anyone ever need this: in PP2010, MergeShapes command doesn't exist. The workaround I used is to select the shapes array and call the Combine command of the ribbon.
Dim oshpR As ShapeRange
Set oshpR = ActivePresentation.Slides(1).Shapes.Range(Array(shp1.ZOrderPosition, shp2.ZOrderPosition))
oshpR.Select
CommandBars.ExecuteMso ("ShapesCombine")
Thank you a lot!
来源：https://stackoverflow.com/questions/29863568/powerpoint-vba-harvey-balls