【发布时间】：2018-09-27 19:30:38
【问题描述】：
我创建了一个宏来循环浏览多个列，创建散点图，将该图导出到特定幻灯片上的 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
【问题讨论】：
-
也许可以试试
if shape.name<>"Button1" then... 之类的按钮名称 -
您需要发布您的代码：在不知道您如何导出到 PPT 的情况下，我不确定我们如何建议更改......
-
在导出之前隐藏
Shape。 -
我尝试了 if 语句，不幸的是它不起作用。出于某种原因，它使一切变得混乱，并将我剪贴板上的所有内容粘贴到每张幻灯片上。我也尝试隐藏形状，但在第一张幻灯片上粘贴了一个空白位置（好像它将形状视为空白但仍将其连接到一个位置，因此它粘贴了我的第一个图表所在的空白位置，然后粘贴其他所有内容偏移一个位置。这是我的代码，包括按钮的隐藏。
-
隐藏形状不会将其从形状集合中删除；如果它是添加图表之前工作表上的第一个形状，它仍然是之后的第一个形状，所以复制第一个形状会给你按钮。你试过 cht.Copy 吗？
标签： vba excel shape powerpoint