Обратный инжиниринг кода VBA, необходимого для создания графиков на слайде

Question

Я ищу способ перестроить код 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

Если я запускаю это на своем примере, я получаю следующий вывод:

Autoshape 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

Я получу другой график, есть мысли о том, где я иду не так?

Answer 1

Автофигура Имя не является автофигурой Тип . Это 2 разных свойства. Вот макрос, чтобы добавить все формы к слайду. Затем найдите номер на этой странице, чтобы получить имя VBA AutoshapeType: Перечисление MsoAutoShapeType

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