幻灯片 VBA Harvey Balls
Powerpoint VBA Harvey Balls
我正在尝试从 PowerPoint 2010+ 中的 VBA 代码创建一些哈维球。
为此，我插入了一个圆形和一个饼图并将它们组合在一起。如果我从功能区插入两个形状然后对齐并组合它们，一切都很好，但是当我从 VBA 插入形状时，组合它们的结果完全不同，我不明白为什么。
所以：
- 从功能区插入形状 -> 使用功能区对齐 -> 使用功能区组合 -> 一切正常
- 插入来自 VBA 的形状 -> 使用色带对齐 -> 使用色带组合 -> 错误结果
你可以在this video中看到它。
VBA 下面插入形状（非常基本）的代码。
ActivePresentation.Slides(slide_num).Shapes.AddShape(msoShapeOval, 100, 100, 50, 50).Select
ActivePresentation.Slides(slide_num).Shapes.AddShape(msoShapePie, 200, 100, 50, 50).Select
请帮忙！
如果饼图（黄色菱形）的两个调整的绝对值是以下 0、90、180、270 值中的任何一个，则组合的行为类似于减法几何运算。这看起来像是 Combine 几何中的错误。相反，如果将值设置为 90.01，则会得到预期的行为。
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
朋友，你真是救命稻草！
只是一个简短的评论，如果有人需要的话：在 PP2010 中，MergeShapes 命令不存在。我使用的解决方法是 select shapes 数组并调用功能区的 Combine 命令。
Dim oshpR As ShapeRange
Set oshpR = ActivePresentation.Slides(1).Shapes.Range(Array(shp1.ZOrderPosition, shp2.ZOrderPosition))
oshpR.Select
CommandBars.ExecuteMso ("ShapesCombine")
非常感谢！
我正在尝试从 PowerPoint 2010+ 中的 VBA 代码创建一些哈维球。 为此，我插入了一个圆形和一个饼图并将它们组合在一起。如果我从功能区插入两个形状然后对齐并组合它们，一切都很好，但是当我从 VBA 插入形状时，组合它们的结果完全不同，我不明白为什么。
所以：
- 从功能区插入形状 -> 使用功能区对齐 -> 使用功能区组合 -> 一切正常
- 插入来自 VBA 的形状 -> 使用色带对齐 -> 使用色带组合 -> 错误结果
你可以在this video中看到它。
VBA 下面插入形状（非常基本）的代码。
ActivePresentation.Slides(slide_num).Shapes.AddShape(msoShapeOval, 100, 100, 50, 50).Select
ActivePresentation.Slides(slide_num).Shapes.AddShape(msoShapePie, 200, 100, 50, 50).Select
请帮忙！
如果饼图（黄色菱形）的两个调整的绝对值是以下 0、90、180、270 值中的任何一个，则组合的行为类似于减法几何运算。这看起来像是 Combine 几何中的错误。相反，如果将值设置为 90.01，则会得到预期的行为。
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
朋友，你真是救命稻草！
只是一个简短的评论，如果有人需要的话：在 PP2010 中，MergeShapes 命令不存在。我使用的解决方法是 select shapes 数组并调用功能区的 Combine 命令。
Dim oshpR As ShapeRange
Set oshpR = ActivePresentation.Slides(1).Shapes.Range(Array(shp1.ZOrderPosition, shp2.ZOrderPosition))
oshpR.Select
CommandBars.ExecuteMso ("ShapesCombine")
非常感谢！