Question

我创建了一个宏来循环遍历多个列，创建散点图，将该绘图导出到特定幻灯片上的powerpoint，删除excel中的原始图表并重复循环。

当我包含一个宏按钮时，会出现问题，因为它将按钮视为一个形状，因此它也会将按钮的图像导出到powerpoint。还有另一种方法可以将按钮定义为除形状之外的其他东西，以便不会发生这种情况吗？

Sub Export_To_PowerPoint_JAH()
' Keyboard Shortcut: Ctrl+Shift+M

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")
Set PPpres = PP.Presentations.Open(Range("B1").Value)

i = 0
A = 0

Do

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

'Create Chart
'----------------------------------------------------
'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 + 5)
    Set rng2Y = .Cells(2, A + 5).End(xlDown)

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

    End With

' 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 + 6)
    Set rng2X = .Cells(2, A + 6).End(xlDown)

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

    End With

'Build chart

Dim Sh As Worksheet
Dim chrt As Chart

Set chrt = Nothing
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 = Cells(i + 5, 2).Value
        .Axes(xlCategory, xlPrimary).HasTitle = True
        .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = Cells(1, A + 6).Value
        .Axes(xlValue, xlPrimary).HasTitle = True
        .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = Cells(1, A + 5).Value
        .Axes(xlCategory).HasMajorGridlines = True

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

'-----------------------------------------------------
'Hide Button From Shape set
ActiveSheet.Shapes("Button 1").Visible = 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

'Pastes Shape to Z slide and Repositions/ Resizes shape
With PPpres.Slides(Z)
    .Shapes.Paste
    With .Shapes(.Shapes.Count)
        .LockAspectRatio = msoTrue
        .Left = Range("B20").Value
        .Top = Range("B21").Value
        .Height = Range("A17").Value
    End With
End With

'Deletes last shape
Shape.Delete

'Clears shape from clipboard
Set Shape = Nothing

i = i + 1
A = A + 3

End With

Loop

MsgBox ("Please Check Your Powerpoint")

End Sub

Answer 1

删除On Error Resume Next。这非常危险，因为它忽略了代码中的错误。
使用Shape.Copy复制形状。

因此，删除此行并写下：

If Not IsItButton(shape.name) Then Shape.Copy

要使其正常工作，请添加此功能：

Public Function IsItButton(nameStr As String) As Boolean    
    IsItButton = CBool(lcase(Left(nameStr, Len("button"))) = "button")    
End Function

Excel将VBA按钮视为形状

1 个答案: