Question

有没有人知道如何使这个宏将图表粘贴到特定的幻灯片，这是基于在Do循环向下移动时在Do循环内发生变化的单元格值？出于某种原因，当它开始粘贴滑动时，它会向底部出现错误＆＃34; Z＆＃34;我将其设置为单元格值。奇怪的是，在调试器中，Z的值正在正确地改变，但是在将图表1粘贴到Z的最初值之后，它将停止粘贴创建的任何其他图表。我注意到＆＃34; On Error Resume Next＆＃34;关闭，运行时错误91出现在行

PPpres.Slides(Z).Shapes.Paste

如果你拿出任何东西，请告诉我。

Sub New_Export_To_PowerPoint()

'On Error Resume Next

Dim Shape As Shape
Dim PP As PowerPoint.Application
Dim PPpres As PowerPoint.Presentation

'Create a PP application and make it visible
 Set PP = New PowerPoint.Application
PP.Visible = msoCTrue

'Open the presentation you wish to copy to
Set PPpres = PP.Presentations.Open("C:\Users\jh307836\Documents\Excel Test.pptx")

i = 0
A = 0

Do

If Cells(i + 5, 3) = "" Then
Exit Do
End If

'Create Chart
'----------------------------------------------------
'Create Range for X
    Dim rng1X As Range, rng2X As Range
    Dim X_Range As Range

With ThisWorkbook.Sheets("Scatter Plots")
    Set rng1X = .Cells(2, A + 5)
    Set rng2X = .Cells(2, A + 5).End(xlDown)

        Set X_Range = .Range(rng1X.Address & ":" & rng2X.Address)

    End With

' Create Range for Y
    Dim rng1Y As Range, rng2Y As Range
    Dim Y_Range As Range

With ThisWorkbook.Sheets("Scatter Plots")
    Set rng1Y = .Cells(2, A + 6)
    Set rng2Y = .Cells(2, A + 6).End(xlDown)

        Set Y_Range = .Range(rng1Y.Address & ":" & rng2Y.Address)

    End With

'Build chart

Dim Sh As Worksheet
Dim chrt As Chart

Set Sh = ActiveWorkbook.Worksheets("Scatter Plots")
Set chrt = Sh.Shapes.AddChart.Chart
With chrt

        'Data
        .ChartType = xlXYScatter
        .SeriesCollection.NewSeries
        .SeriesCollection(1).Name = "=""Scatter Chart"""
        .SeriesCollection(1).XValues = X_Range
        .SeriesCollection(1).Values = Y_Range


        'Titles
        .HasTitle = True
        .ChartTitle.Characters.Text = "PPT Test"
        .Axes(xlCategory, xlPrimary).HasTitle = True
        .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = Cells(1, A + 5).Value
        .Axes(xlValue, xlPrimary).HasTitle = True
        .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = Cells(1, A + 6).Value
        .Axes(xlCategory).HasMajorGridlines = True

        'Formatting
        .Axes(xlCategory).HasMinorGridlines = False
        .Axes(xlValue).HasMajorGridlines = True
        .Axes(xlValue).HasMinorGridlines = False
        .HasLegend = False

'-----------------------------------------------------

'Set the shape you want to copy (1) means current plot "random"
Set Shape = Worksheets("Scatter Plots").Shapes(1)


'Copy the shape
Shape.Copy

'Define Slide #
Z = Cells(i + 5, 3).Value

'Paste on the "Z" slide
PPpres.Slides(Z).Shapes.Paste
Set Sh = Nothing
Set PP = Nothing
Set PPpres = Nothing

Shape.Delete

i = i + 1
A = A + 3

End With

Loop

MsgBox ("Done")

End Sub

在多个幻灯片VBA上将图表粘贴到Powerpoint上

0 个答案: