VBA PowerPoint - 复制形状或组答案

【问题标题】：VBA PowerPoint - Copy shape or groupVBA PowerPoint - 复制形状或组
【发布时间】：2020-04-24 20:38:51
【问题描述】：

我正在尝试在 PowerPoint 中使用 VBA 复制 2 个形状和一组名为 SP_MP、SP_TEST 的形状以及名为 SP_MP_START 的组，该组来自同一张幻灯片中的活动幻灯片，位于以下位置83.52, 41.62。问题是我不知道如何引用形状和组来复制它们以及使用什么命令。

提前谢谢你，斯特凡。

【问题讨论】：

PowerPoint 有没有像 Excel 一样的录制宏功能？如果是，那么您可以使用它来跟踪您对菜单的操作并生成源代码。
不幸的是，Microsoft 从 PowerPoint 2010 开始删除了该功能。
我很惊讶他们当时并没有删除对 VBA 的支持...你能找到旧版本的 Excel 来创建宏吗？
感谢您的帮助，我找到了一个变通的解决方案，实际上是使用以下代码通过 VBA 创建所需的形状：

标签： vba powerpoint shapes

【解决方案1】：

    Private Sub CommandButton1_Click()

Dim Sld As Slide
Dim Shp As Shape

'ERROR HANDLING
    If ActivePresentation.Slides.Count = 0 Then
        MsgBox "You do not have any slides in your PowerPoint project."
        Exit Sub
    End If

Set Sld = Application.ActiveWindow.View.Slide

'Create shape with Specified Dimensions and Slide Position
    Set Shp = Sld.Shapes.AddShape(Type:=msoShapeFlowchartPredefinedProcess, _
        Left:=50, Top:=100, Width:=83.52, Height:=41.62)

'FORMAT SHAPE
    'Shape Name
        Shp.Name = "My Header"

    'No Shape Border
        Shp.Line.Visible = msoTrue

    'Shape Fill Color
        Shp.Fill.ForeColor.RGB = RGB(255, 255, 255)

    'Shape Text Color
        Shp.TextFrame.TextRange.Font.Color.RGB = RGB(0, 0, 0)

    'Text inside Shape
        Shp.TextFrame.TextRange.Characters.Text = TextBox1

    'Center Align Text
        Shp.TextFrame.TextRange.Paragraphs.ParagraphFormat.Alignment = ppAlignCenter

    'Vertically Align Text to Middle
        Shp.TextFrame2.VerticalAnchor = msoAnchorMiddle

    'Adjust Font Size
        Shp.TextFrame2.TextRange.Font.Size = 8

    'Adjust Font Style
        Shp.TextFrame2.TextRange.Font.Name = "Verdana (Body)"

Unload UserForm4

End Sub

【讨论】：

您还可以在子程序的顶部添加以下内容： If False ThenErrorHandler:MsgBox Err.DescriptionEnd If