对在幻灯片中生成图表所需的 VBA 代码进行逆向工程

Reverse engineer the VBA code you need to produce graphs in a slide

我正在寻找一种重新设计 VBA 代码的方法,我需要在 PowerPoint 中创建特定的视觉效果。

例如,我想创建代码来创建这个:

现在我已经编写了以下 VBA 代码,可以让您突出显示 powerpoint 中使用的形状:

Sub ListAllShapes()

Dim curSlide As Slide
Dim curShape As Shape

For Each curSlide In ActivePresentation.Slides
    Debug.Print curSlide.SlideNumber
    For Each curShape In curSlide.Shapes


                MsgBox curShape.Name


    Next curShape
Next curSlide
End Sub

如果我 运行 使用我的示例,我会得到以下输出:

自选图形 7

然而,当我在此处查找 Shape.name 时:https://docs.microsoft.com/en-us/office/vba/api/office.msoautoshapetype 我看到 Autoshpape 7 是 msoShapeIsoscelesTriangle。如果我再插入以下代码:

Sub InsertShape()

Set myDocument = ActivePresentation.Slides(1)
myDocument.Shapes.AddShape Type:=msoShapeIsoscelesTriangle, _
    Left:=50, Top:=50, Width:=100, Height:=200


End Sub

我得到了一张不同的图表,有什么地方出错了吗?

自选图形 名称 不是自选图形 类型。它们是 2 个不同的属性。这是一个将所有形状添加到幻灯片的宏。然后在此页面上查找编号以获取 VBA AutoshapeType 名称:MsoAutoShapeType enumeration

Sub MakeShapes()
    Dim T As Long, L As Long
    Dim oShape As Shape, oText As Shape

    T = 0
    L = 0
    x = 1
    For y = 1 To 15
        For Z = 1 To 26
            On Error GoTo NoShape
            Set oShape = ActiveWindow.Selection.SlideRange.Shapes.AddShape(Type:=x, Left:=L, Top:=T, Width:=30, Height:=30)
            On Error GoTo -1
            Set oText = ActiveWindow.Selection.SlideRange.Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, Left:=L, Top:=T + 36, Width:=36, Height:=18)
            With oText.TextFrame2.TextRange
                .Text = oShape.AutoShapeType
                .Font.Size = 10
            End With
            Set oShape = Nothing
            Set oText = Nothing
            L = L + 36
NoShape:
            x = x + 1
            If x = 184 Then Exit Sub
        Next Z
        L = 0
        T = T + 71
    Next y
End Sub