如何为VBA中的每个范围制作PowerPoint幻灯片

Question

如何根据Excel范围A2：B2制作powerpoint幻灯片。 excel行A1到A10的所有字符（countryname）都将其作为Powerpoint幻灯片。

这是抛出数组错误的代码：

Sub PasteMultipleSlides()
    Dim myPresentation As Object
    Dim mySlide As Object
    Dim PowerPointApp As Object
    Dim shp As Object
    Dim MySlideArray As Variant
    Dim MyRangeArray As Variant
    Dim x As Long

    On Error Resume Next

    Set PowerPointApp = GetObject(class:="PowerPoint.Application")

    'Clear the error between errors
    Err.Clear

    'If PowerPoint is not already open then Exit
    If PowerPointApp Is Nothing Then
        MsgBox "PowerPoint Presentation is not open, aborting."
        Exit Sub
    End If

    'Handle if the PowerPoint Application is not found
    If Err.Number = 429 Then
        MsgBox "PowerPoint could not be found, aborting."
        Exit Sub
    End If

    On Error GoTo 0

    'Make PowerPoint Visible and Active
    PowerPointApp.ActiveWindow.Panes(2).Activate

    'Create a New Presentation
    Set myPresentation = PowerPointApp.ActivePresentation

    'List of PPT Slides to Paste to
    MySlideArray = Array(2, 3, 4, 5, 6)

    'List of Excel Ranges to Copy from
    MyRangeArray = Array(Sheet1.Range("A2:B10"))

    'Loop through Array data
    For x = LBound(MySlideArray) To UBound(MySlideArray)
        'Copy Excel Range
        MyRangeArray(x).Copy

        'Paste to PowerPoint and position
        On Error Resume Next
        Set shp = myPresentation.Slides(MySlideArray(x)).Shapes.PasteSpecial(DataType:=2)    'Excel 2007-2010
        Set shp = PowerPointApp.ActiveWindow.Selection.ShapeRange    'Excel 2013
        On Error GoTo 0

        'Center Object
        With myPresentation.PageSetup
            shp.Left = (.SlideWidth \ 2) - (shp.Width \ 2)
            shp.Top = (.SlideHeight \ 2) - (shp.Height \ 2)
        End With

    Next x

    'Transfer Complete
    Application.CutCopyMode = False
    ThisWorkbook.Activate
    MsgBox "Complete!"

End Sub