VBA 粘贴到 Powerpoint 时崩溃
VBA Crashing when pasting into Powerpoint
我制作了一个宏，可以在 excel 中创建一些图表，然后打开 powerpoint 并将它们粘贴到模板中。在过去的几周里，它一直工作得很好，但是在将一些东西添加到宏中之后（它们是完全独立的东西，比如刷新数据和设置过滤器），它似乎在将图表粘贴到 powerpoint 中时崩溃了。过去还有其他人遇到过类似的问题吗？似乎没有任何理由应该这样做......
Sub PowerpointPres(r)
Dim PPT As Object
Dim PPApp As Object
Dim PPPres As Object
Dim PPSlide As Object
Dim PPShape As Shape
Set PPT = CreateObject("PowerPoint.Application")
PPT.Visible = True
PPT.Presentations.Open filename:="S:\Commercial Finance\Macros for Standard Reporting\Country Manager Presentation Macro\CM Presentation Template.pptm"
Set PPApp = CreateObject("Powerpoint.Application")
Set PPApp = GetObject(, "Powerpoint.Application")
Set PPPres = PPApp.ActivePresentation
'Slide 1
Set PPSlide = PPPres.Slides(1)
PPSlide.Shapes(1).TextFrame.TextRange.Text = r & " Country Review YTD " & Year(Now())
'Slide 2
Set PPSlide = PPPres.Slides(2)
PPSlide.Shapes(1).TextFrame.TextRange.Text = r & " Country Review YTD " & Year(Now())
'Slide 3
Pivots.ChartObjects(1).Copy
i = Pivots.Range("G14").Text
j = Pivots.Range("H14").Text
Set PPSlide = PPPres.Slides(3)
With PPSlide
.Shapes(1).TextFrame.TextRange.Text = r & " TCV YTD " & Year(Now()) - 1 & " and " & Year(Now()) & " - by Sector"
.Shapes(2).TextFrame.TextRange.Text = "Totals:" & Year(Now()) - 1 & ":" & i & "" & Year(Now()) & ":" & j
End With
PPApp.ActiveWindow.View.GotoSlide (3)
PPSlide.Shapes.PasteSpecial(DataType:=ppPasteDefault).Select
'PPApp.ActiveWindow.View.Paste
With PPSlide.Shapes(3)
.Top = 55
.Left = 85
.Height = 350
.Width = 550
With .Chart.SeriesCollection(1).Format.Fill
.TwoColorGradient 2, 1
.ForeColor.RGB = RGB(0, 94, 140)
.BackColor.RGB = RGB(0, 165, 241)
.GradientStops.Insert RGB(0, 138, 202), 0.5
End With
With .Chart.SeriesCollection(2).Format.Fill
.TwoColorGradient 2, 1
.ForeColor.RGB = RGB(85, 85, 85)
.BackColor.RGB = RGB(125, 125, 125)
.GradientStops.Insert RGB(150, 150, 150), 0.5
End With
End With
Application.Wait (Now + TimeValue("00:00:05"))
'Slide 4
Pivots.ChartObjects(2).Copy
i = Pivots.Range("V14").Text
j = Pivots.Range("W14").Text
Set PPSlide = PPPres.Slides(4)
With PPSlide
.Shapes(1).TextFrame.TextRange.Text = r & " TCV YTD " & Year(Now()) - 1 & " and " & Year(Now()) & " - by Type"
.Shapes(2).TextFrame.TextRange.Text = "Totals:" & Year(Now()) - 1 & ":" & i & "" & Year(Now()) & ":" & j
End With
PPApp.ActiveWindow.View.GotoSlide (4)
'PPApp.CommandBars.ExecuteMso ("PasteSourceFormatting")
PPSlide.Shapes.PasteSpecial(DataType:=ppPasteDefault).Select
With PPSlide.Shapes(3)
.Top = 55
.Left = 85
.Height = 350
.Width = 550
With .Chart.SeriesCollection(1).Format.Fill
.TwoColorGradient 2, 1
.ForeColor.RGB = RGB(0, 94, 140)
.BackColor.RGB = RGB(0, 165, 241)
.GradientStops.Insert RGB(0, 138, 202), 0.5
End With
With .Chart.SeriesCollection(2).Format.Fill
.TwoColorGradient 2, 1
.ForeColor.RGB = RGB(85, 85, 85)
.BackColor.RGB = RGB(125, 125, 125)
.GradientStops.Insert RGB(150, 150, 150), 0.5
End With
End With
'Slide 5
LRow = Pivots.Range("AH8").End(xlDown).Row
Pivots.Range("AH8:AI" & LRow).Copy
Set PPSlide = PPPres.Slides(5)
PPApp.ActiveWindow.View.GotoSlide (5)
PPApp.ActiveWindow.View.Paste
With PPSlide.Shapes(2)
.Top = 70
.Left = 50
.Height = 400
.Width = 200
End With
Pivots.ChartObjects(3).Copy
PPApp.ActiveWindow.View.GotoSlide (5)
With PPSlide
.Shapes(1).TextFrame.TextRange.Text = r & " New TCV by AM YTD " & Year(Now())
End With
PPApp.ActiveWindow.View.Paste
With PPSlide.Shapes(3)
.Top = 80
.Left = 300
.Height = 380
.Width = 350
End With
'Slide 6
LRow = Pivots.Range("AN8").End(xlDown).Row
Pivots.Rows("8:" & LRow).RowHeight = 20
Pivots.Range("AN8:AO" & LRow).Copy
Set PPSlide = PPPres.Slides(6)
PPApp.ActiveWindow.View.GotoSlide (6)
PPApp.ActiveWindow.View.Paste
With PPSlide.Shapes(2)
.Top = 70
.Left = 50
.Height = 380
.Width = 200
End With
Pivots.ChartObjects(4).Copy
PPApp.ActiveWindow.View.GotoSlide (6)
With PPSlide
.Shapes(1).TextFrame.TextRange.Text = r & " New TCV by Product YTD " & Year(Now())
End With
PPApp.ActiveWindow.View.Paste
With PPSlide.Shapes(3)
.Top = 80
.Left = 300
.Height = 380
.Width = 350
End With
Application.Wait (Now + TimeValue("00:00:05"))
'Slide 7
LRow = Pivots.Range("AY8").End(xlDown).Row
Pivots.Range("AT1:AZ" & LRow).Copy
Set PPSlide = PPPres.Slides(7)
PPApp.ActiveWindow.View.GotoSlide (7)
'PPSlide.Shapes.PasteSpecial(DataType:=2).Select
PPApp.ActiveWindow.View.Paste
With PPSlide
.Shapes(1).TextFrame.TextRange.Text = r & " Top 10 TCV New Deals Signed YTD " & Year(Now())
End With
With PPSlide.Shapes(2)
.Top = 70
.Left = 30
.Height = 380
.Width = 660
End With
'Slide 9
LRow = Pivots.Range("BG1").End(xlDown).Row
Pivots.Range("BD1:BG" & LRow).Copy
Set PPSlide = PPPres.Slides(9)
PPApp.ActiveWindow.View.GotoSlide (9)
'PPSlide.Shapes.PasteSpecial(DataType:=2).Select
PPApp.ActiveWindow.View.Paste
With PPSlide
.Shapes(1).TextFrame.TextRange.Text = r & " IR – Top 10 Customers YTD " & Year(Now())
End With
With PPSlide.Shapes(2)
.Top = 70
.Left = 30
.Height = 380
.Width = 660
End With
Application.Wait (Now + TimeValue("00:00:05"))
'Slide 10
Pivots.ChartObjects(11).Copy
i = Pivots.Range("CZ19").Text
j = Pivots.Range("DA19").Text
Set PPSlide = PPPres.Slides(10)
With PPSlide
.Shapes(1).TextFrame.TextRange.Text = r & " New IIR YTD " & Year(Now()) - 1 & " and " & Year(Now()) & " - by Sales Sector"
.Shapes(2).TextFrame.TextRange.Text = "Totals:" & Year(Now()) - 1 & ":" & i & "" & Year(Now()) & ":" & j
End With
PPApp.ActiveWindow.View.GotoSlide (10)
PPSlide.Shapes.PasteSpecial(DataType:=ppPasteDefault).Select
'PPApp.ActiveWindow.View.Paste
With PPSlide.Shapes(3)
.Top = 55
.Left = 85
.Height = 350
.Width = 550
With .Chart.SeriesCollection(1).Format.Fill
.TwoColorGradient 2, 1
.ForeColor.RGB = RGB(0, 94, 140)
.BackColor.RGB = RGB(0, 165, 241)
.GradientStops.Insert RGB(0, 138, 202), 0.5
End With
With .Chart.SeriesCollection(2).Format.Fill
.TwoColorGradient 2, 1
.ForeColor.RGB = RGB(85, 85, 85)
.BackColor.RGB = RGB(125, 125, 125)
.GradientStops.Insert RGB(150, 150, 150), 0.5
End With
End With
'Slide 11
Pivots.ChartObjects(5).Copy
Set PPSlide = PPPres.Slides(11)
LRow = Pivots.Range("BK:BO").Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
i = Pivots.Range("BL" & LRow).Text
j = Pivots.Range("BM" & LRow).Text
k = Pivots.Range("BN" & LRow).Text
l = Pivots.Range("BO" & LRow).Text
PPApp.ActiveWindow.View.GotoSlide (11)
With PPSlide
.Shapes(1).TextFrame.TextRange.Text = r & " Monthly Net MRC YTD " & Year(Now())
With .Shapes(2)
.TextFrame.TextRange.Text = "MRC Won " & Year(Now()) & " YTD: € " & i
.Top = 5
.Left = 475
.Height = 30
.Width = 250
End With
With .Shapes(3)
.TextFrame.TextRange.Text = "MRC Ceased " & Year(Now()) & " YTD: € " & j
.Top = 20
.Left = 475
.Height = 30
.Width = 250
End With
With .Shapes(4)
.TextFrame.TextRange.Text = "MRC Erosion " & Year(Now()) & " YTD: € " & k
.Top = 35
.Left = 475
.Height = 30
.Width = 250
End With
With .Shapes(5)
.TextFrame.TextRange.Text = "Net MRC " & Year(Now()) & " YTD: € " & l
.Top = 50
.Left = 475
.Height = 30
.Width = 250
End With
End With
PPApp.ActiveWindow.View.Paste
With PPSlide.Shapes(6)
.Top = 80
.Left = 30
.Height = 380
.Width = 650
With .Chart
.ChartStyle = 2
.SeriesCollection(1).Format.Fill.ForeColor.RGB = RGB(146, 208, 80)
.SeriesCollection(2).Format.Fill.ForeColor.RGB = RGB(255, 0, 0)
.SeriesCollection(3).Format.Fill.ForeColor.RGB = RGB(246, 139, 31)
.SeriesCollection(4).Format.Fill.ForeColor.RGB = RGB(51, 51, 255)
End With
End With
'Slide 12
LRow = Pivots.Range("BR1").End(xlDown).Row
Pivots.Range("BR1:BW" & LRow).Copy
Set PPSlide = PPPres.Slides(12)
PPApp.ActiveWindow.View.GotoSlide (12)
'PPSlide.Shapes.PasteSpecial(DataType:=2).Select
PPApp.ActiveWindow.View.Paste
With PPSlide
.Shapes(1).TextFrame.TextRange.Text = r & " Net MRC - Top 10 Customer YTD " & Year(Now())
End With
With PPSlide.Shapes(2)
.Top = 70
.Left = 30
.Height = 380
.Width = 660
End With
Application.Wait (Now + TimeValue("00:00:05"))
'Slide 13
Pivots.ChartObjects(6).Copy
Set PPSlide = PPPres.Slides(13)
PPApp.ActiveWindow.View.GotoSlide (13)
With PPSlide
.Shapes(1).TextFrame.TextRange.Text = r & " Revenue at Risk – MRC up for renewal"
End With
PPApp.ActiveWindow.View.Paste
With PPSlide.Shapes(2)
.Top = 50
.Left = 30
.Height = 420
.Width = 650
.Chart.ChartStyle = 8
End With
'Slide 14
Pivots.ChartObjects(7).Copy
Set PPSlide = PPPres.Slides(14)
PPApp.ActiveWindow.View.GotoSlide (14)
With PPSlide
.Shapes(1).TextFrame.TextRange.Text = r & " Revenue at Risk – Top 10 MRC up for renewal " & Year(Now())
End With
PPApp.ActiveWindow.View.Paste
With PPSlide.Shapes(2)
.Top = 50
.Left = 30
.Height = 420
.Width = 650
.Chart.ChartStyle = 8
End With
'Slide 15
Pivots.ChartObjects(8).Copy
Set PPSlide = PPPres.Slides(15)
i = Year(DateSerial(Year(Now()), Month(Now()), Day(Now())))
j = Month(DateSerial(Year(Now()), Month(Now()), Day(Now())))
PPApp.ActiveWindow.View.GotoSlide (15)
With PPSlide
.Shapes(1).TextFrame.TextRange.Text = r & " – Top 5 MRC expiring " & Left(MonthName(j), 3) & "-" & i
End With
PPApp.ActiveWindow.View.Paste
With PPSlide.Shapes(2)
.Top = 50
.Left = 30
.Height = 370
.Width = 650
.Chart.ChartStyle = 8
End With
Application.Wait (Now + TimeValue("00:00:05"))
'Slide 16
Pivots.ChartObjects(9).Copy
Set PPSlide = PPPres.Slides(16)
i = Year(DateSerial(Year(Now()), Month(Now()) + 1, Day(Now())))
j = Month(DateSerial(Year(Now()), Month(Now()) + 1, Day(Now())))
PPApp.ActiveWindow.View.GotoSlide (16)
With PPSlide
.Shapes(1).TextFrame.TextRange.Text = r & " – Top 5 MRC expiring " & Left(MonthName(j), 3) & "-" & i
End With
PPApp.ActiveWindow.View.Paste
With PPSlide.Shapes(2)
.Top = 50
.Left = 30
.Height = 370
.Width = 650
.Chart.ChartStyle = 8
End With
'Slide 17
Pivots.ChartObjects(10).Copy
Set PPSlide = PPPres.Slides(17)
i = Year(DateSerial(Year(Now()), Month(Now()) + 2, Day(Now())))
j = Month(DateSerial(Year(Now()), Month(Now()) + 2, Day(Now())))
PPApp.ActiveWindow.View.GotoSlide (17)
With PPSlide
.Shapes(1).TextFrame.TextRange.Text = r & " – Top 5 MRC expiring " & Left(MonthName(j), 3) & "-" & i
End With
PPApp.ActiveWindow.View.Paste
With PPSlide.Shapes(2)
.Top = 50
.Left = 30
.Height = 370
.Width = 650
.Chart.ChartStyle = 8
End With
'Slide 18
Pivots.Range("FJ1:FO11").Copy
Set PPSlide = PPPres.Slides(18)
PPApp.ActiveWindow.View.GotoSlide (18)
PPApp.ActiveWindow.View.Paste
With PPSlide.Shapes(1)
.TextFrame.TextRange.Text = r & ": SalesForce Pipeline & Top Deals"
.Left = 100
.Top = 10
.Height = 50
.Width = 650
End With
Pivots.Range("SalesForceTable2").Copy
PPApp.ActiveWindow.View.Paste
With PPSlide.Shapes(2)
.Top = 130
.Left = 30
.Height = 320
.Width = 660
End With
With PPSlide.Shapes(3)
.Top = 70
.Left = 30
.Height = 50
.Width = 660
End With
Application.Wait (Now + TimeValue("00:00:05"))
'Slide 19
LRow = Pivots.Range("EC1").End(xlDown).Row
If LRow < 19 Then
Pivots.Range("EC1:EL" & LRow).Copy
Else
Pivots.Range("EC1:EL19").Copy
End If
Set PPSlide = PPPres.Slides(19)
PPApp.ActiveWindow.View.GotoSlide (19)
'PPSlide.Shapes.PasteSpecial(DataType:=2).Select
PPApp.ActiveWindow.View.Paste
With PPSlide.Shapes(1)
.TextFrame.TextRange.Text = r & " Individual Performance YTD " & Year(Now()) & " (pg1)"
.Left = 20
.Top = 20
.Height = 50
.Width = 650
End With
With PPSlide.Shapes(2)
.Top = 70
.Left = 30
.Height = 380
.Width = 660
End With
'Slide 20
If LRow > 19 Then
Pivots.Range("EM2:EV20").ClearContents
If LRow > 19 And LRow <= 37 Then
Pivots.Range("EC20:EL" & LRow).Copy
Else
Pivots.Range("EC20:EL37").Copy
End If
Pivots.Range("EM2").PasteSpecial xlValues
LRow2 = Pivots.Range("EM1").End(xlDown).Row
Columns("EM:EV").EntireColumn.AutoFit
Pivots.Range("EM1:EV" & LRow2).Copy
Set PPLayout = PPPres.Slides(19).CustomLayout
Set PPSlide = PPPres.Slides.AddSlide(20, PPLayout)
Set PPSlide = PPPres.Slides(20)
With PPSlide
.Shapes(2).Delete
End With
PPApp.ActiveWindow.View.GotoSlide (20)
PPApp.ActiveWindow.View.Paste
With PPSlide.Shapes(1)
.TextFrame.TextRange.Font.Size = 28
.TextFrame.TextRange.Text = r & " Individual Performance YTD " & Year(Now()) & " (pg2)"
.Left = 20
.Top = 20
.Height = 50
.Width = 650
End With
With PPSlide.Shapes(2)
.Top = 70
.Left = 30
.Height = 380
.Width = 660
End With
Else
On Error GoTo ContinueHere
For i = PPApp.Slides.Count To 20 Step -1
PPPres.Slides(i).Delete
Next
On Error GoTo 0
End If
Application.Wait (Now + TimeValue("00:00:05"))
'slide 21
If LRow > 37 Then
Pivots.Range("EM2:EV20").ClearContents
If LRow > 37 And LRow <= 55 Then
Pivots.Range("EC38:EL" & LRow).Copy
Else
Pivots.Range("EC38:EL55").Copy
End If
Pivots.Range("EM2").PasteSpecial xlValues
LRow2 = Pivots.Range("EM1").End(xlDown).Row
Columns("EM:EV").EntireColumn.AutoFit
Pivots.Range("EM1:EV" & LRow2).Copy
Set PPLayout = PPPres.Slides(19).CustomLayout
Set PPSlide = PPPres.Slides.AddSlide(21, PPLayout)
Set PPSlide = PPPres.Slides(21)
With PPSlide
.Shapes(2).Delete
End With
PPApp.ActiveWindow.View.GotoSlide (21)
PPApp.ActiveWindow.View.Paste
With PPSlide.Shapes(1)
.TextFrame.TextRange.Font.Size = 28
.TextFrame.TextRange.Text = r & " Individual Performance YTD " & Year(Now()) & " (pg3)"
.Left = 20
.Top = 20
.Height = 50
.Width = 650
End With
With PPSlide.Shapes(2)
.Top = 70
.Left = 30
.Height = 380
.Width = 660
End With
Else
On Error GoTo ContinueHere
For i = PPApp.Slides.Count To 20 Step -1
PPPres.Slides(i).Delete
Next
On Error GoTo 0
End If
'Slide 22
If LRow > 55 Then
Pivots.Range("EM2:EV20").ClearContents
If LRow > 55 And LRow <= 73 Then
Pivots.Range("EC56:EL" & LRow).Copy
Else
Pivots.Range("EC56:EL73").Copy
End If
Pivots.Range("EM2").PasteSpecial xlValues
LRow2 = Pivots.Range("EM1").End(xlDown).Row
Columns("EM:EV").EntireColumn.AutoFit
Pivots.Range("EM1:EV" & LRow2).Copy
Set PPLayout = PPPres.Slides(19).CustomLayout
Set PPSlide = PPPres.Slides.AddSlide(22, PPLayout)
Set PPSlide = PPPres.Slides(22)
With PPSlide
.Shapes(2).Delete
End With
PPApp.ActiveWindow.View.GotoSlide (22)
PPApp.ActiveWindow.View.Paste
With PPSlide.Shapes(1)
.TextFrame.TextRange.Font.Size = 28
.TextFrame.TextRange.Text = r & " Individual Performance YTD " & Year(Now()) & " (pg4)"
.Left = 20
.Top = 20
.Height = 50
.Width = 650
End With
With PPSlide.Shapes(2)
.Top = 70
.Left = 30
.Height = 380
.Width = 660
End With
Else
On Error GoTo ContinueHere
For i = PPApp.Slides.Count To 20 Step -1
PPPres.Slides(i).Delete
Next
On Error GoTo 0
End If
'slide 23
If LRow > 73 Then
Pivots.Range("EM2:EV20").ClearContents
If LRow > 73 And LRow <= 91 Then
Pivots.Range("EC74:EL" & LRow).Copy
Else
Pivots.Range("EC74:EL91").Copy
End If
Pivots.Range("EM2").PasteSpecial xlValues
LRow2 = Pivots.Range("EM1").End(xlDown).Row
Columns("EM:EV").EntireColumn.AutoFit
Pivots.Range("EM1:EV" & LRow2).Copy
Set PPLayout = PPPres.Slides(19).CustomLayout
Set PPSlide = PPPres.Slides.AddSlide(23, PPLayout)
Set PPSlide = PPPres.Slides(23)
With PPSlide
.Shapes(2).Delete
End With
PPApp.ActiveWindow.View.GotoSlide (23)
PPApp.ActiveWindow.View.Paste
With PPSlide.Shapes(1)
.TextFrame.TextRange.Font.Size = 28
.TextFrame.TextRange.Text = r & " Individual Performance YTD " & Year(Now()) & " (pg5)"
.Left = 20
.Top = 20
.Height = 50
.Width = 650
End With
With PPSlide.Shapes(2)
.Top = 70
.Left = 30
.Height = 380
.Width = 660
End With
Else
On Error GoTo ContinueHere
For i = PPApp.Slides.Count To 20 Step -1
PPPres.Slides(i).Delete
Next
On Error GoTo 0
End If
ContinueHere:
PPApp.ActivePresentation.SaveAs "S:\Commercial Finance\Macros for Standard Reporting\Country Manager Presentation Macro\Outputs\" & r & "\" & Format(Now(), "dd-MM-yyyy") & ".pptm"
PPApp.ActivePresentation.Close
PPApp.Quit
' Clean up
Set PPSlide = Nothing
Set PPPres = Nothing
Set PPApp = Nothing
End Sub
我从你那里了解到它给出的错误是Shapes.PasteSpecial : Invalid request. Clipboard is empty or contains data which may not be pasted here.
问题是剪贴板在调用复制操作后并没有立即准备好粘贴，而是需要一些时间来加载数据。让我们给它时间：
添加包含此代码的小模块：
Option Explicit
#If VBA7 Then
Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr) 'For 64 Bit Systems
#Else
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 'For 32 Bit Systems
#End If
现在在复制和粘贴语句之间插入以下延迟：
Dim i as Integer
For i = 1 To 6
DoEvents()
Sleep 500 'milliseconds
Next i
这应该给复制操作足够的时间来填充剪贴板。
如果太高或太低，您可以在上面的循环中调整常数"6"。
我制作了一个宏，可以在 excel 中创建一些图表，然后打开 powerpoint 并将它们粘贴到模板中。在过去的几周里，它一直工作得很好，但是在将一些东西添加到宏中之后（它们是完全独立的东西，比如刷新数据和设置过滤器），它似乎在将图表粘贴到 powerpoint 中时崩溃了。过去还有其他人遇到过类似的问题吗？似乎没有任何理由应该这样做......
Sub PowerpointPres(r)
Dim PPT As Object
Dim PPApp As Object
Dim PPPres As Object
Dim PPSlide As Object
Dim PPShape As Shape
Set PPT = CreateObject("PowerPoint.Application")
PPT.Visible = True
PPT.Presentations.Open filename:="S:\Commercial Finance\Macros for Standard Reporting\Country Manager Presentation Macro\CM Presentation Template.pptm"
Set PPApp = CreateObject("Powerpoint.Application")
Set PPApp = GetObject(, "Powerpoint.Application")
Set PPPres = PPApp.ActivePresentation
'Slide 1
Set PPSlide = PPPres.Slides(1)
PPSlide.Shapes(1).TextFrame.TextRange.Text = r & " Country Review YTD " & Year(Now())
'Slide 2
Set PPSlide = PPPres.Slides(2)
PPSlide.Shapes(1).TextFrame.TextRange.Text = r & " Country Review YTD " & Year(Now())
'Slide 3
Pivots.ChartObjects(1).Copy
i = Pivots.Range("G14").Text
j = Pivots.Range("H14").Text
Set PPSlide = PPPres.Slides(3)
With PPSlide
.Shapes(1).TextFrame.TextRange.Text = r & " TCV YTD " & Year(Now()) - 1 & " and " & Year(Now()) & " - by Sector"
.Shapes(2).TextFrame.TextRange.Text = "Totals:" & Year(Now()) - 1 & ":" & i & "" & Year(Now()) & ":" & j
End With
PPApp.ActiveWindow.View.GotoSlide (3)
PPSlide.Shapes.PasteSpecial(DataType:=ppPasteDefault).Select
'PPApp.ActiveWindow.View.Paste
With PPSlide.Shapes(3)
.Top = 55
.Left = 85
.Height = 350
.Width = 550
With .Chart.SeriesCollection(1).Format.Fill
.TwoColorGradient 2, 1
.ForeColor.RGB = RGB(0, 94, 140)
.BackColor.RGB = RGB(0, 165, 241)
.GradientStops.Insert RGB(0, 138, 202), 0.5
End With
With .Chart.SeriesCollection(2).Format.Fill
.TwoColorGradient 2, 1
.ForeColor.RGB = RGB(85, 85, 85)
.BackColor.RGB = RGB(125, 125, 125)
.GradientStops.Insert RGB(150, 150, 150), 0.5
End With
End With
Application.Wait (Now + TimeValue("00:00:05"))
'Slide 4
Pivots.ChartObjects(2).Copy
i = Pivots.Range("V14").Text
j = Pivots.Range("W14").Text
Set PPSlide = PPPres.Slides(4)
With PPSlide
.Shapes(1).TextFrame.TextRange.Text = r & " TCV YTD " & Year(Now()) - 1 & " and " & Year(Now()) & " - by Type"
.Shapes(2).TextFrame.TextRange.Text = "Totals:" & Year(Now()) - 1 & ":" & i & "" & Year(Now()) & ":" & j
End With
PPApp.ActiveWindow.View.GotoSlide (4)
'PPApp.CommandBars.ExecuteMso ("PasteSourceFormatting")
PPSlide.Shapes.PasteSpecial(DataType:=ppPasteDefault).Select
With PPSlide.Shapes(3)
.Top = 55
.Left = 85
.Height = 350
.Width = 550
With .Chart.SeriesCollection(1).Format.Fill
.TwoColorGradient 2, 1
.ForeColor.RGB = RGB(0, 94, 140)
.BackColor.RGB = RGB(0, 165, 241)
.GradientStops.Insert RGB(0, 138, 202), 0.5
End With
With .Chart.SeriesCollection(2).Format.Fill
.TwoColorGradient 2, 1
.ForeColor.RGB = RGB(85, 85, 85)
.BackColor.RGB = RGB(125, 125, 125)
.GradientStops.Insert RGB(150, 150, 150), 0.5
End With
End With
'Slide 5
LRow = Pivots.Range("AH8").End(xlDown).Row
Pivots.Range("AH8:AI" & LRow).Copy
Set PPSlide = PPPres.Slides(5)
PPApp.ActiveWindow.View.GotoSlide (5)
PPApp.ActiveWindow.View.Paste
With PPSlide.Shapes(2)
.Top = 70
.Left = 50
.Height = 400
.Width = 200
End With
Pivots.ChartObjects(3).Copy
PPApp.ActiveWindow.View.GotoSlide (5)
With PPSlide
.Shapes(1).TextFrame.TextRange.Text = r & " New TCV by AM YTD " & Year(Now())
End With
PPApp.ActiveWindow.View.Paste
With PPSlide.Shapes(3)
.Top = 80
.Left = 300
.Height = 380
.Width = 350
End With
'Slide 6
LRow = Pivots.Range("AN8").End(xlDown).Row
Pivots.Rows("8:" & LRow).RowHeight = 20
Pivots.Range("AN8:AO" & LRow).Copy
Set PPSlide = PPPres.Slides(6)
PPApp.ActiveWindow.View.GotoSlide (6)
PPApp.ActiveWindow.View.Paste
With PPSlide.Shapes(2)
.Top = 70
.Left = 50
.Height = 380
.Width = 200
End With
Pivots.ChartObjects(4).Copy
PPApp.ActiveWindow.View.GotoSlide (6)
With PPSlide
.Shapes(1).TextFrame.TextRange.Text = r & " New TCV by Product YTD " & Year(Now())
End With
PPApp.ActiveWindow.View.Paste
With PPSlide.Shapes(3)
.Top = 80
.Left = 300
.Height = 380
.Width = 350
End With
Application.Wait (Now + TimeValue("00:00:05"))
'Slide 7
LRow = Pivots.Range("AY8").End(xlDown).Row
Pivots.Range("AT1:AZ" & LRow).Copy
Set PPSlide = PPPres.Slides(7)
PPApp.ActiveWindow.View.GotoSlide (7)
'PPSlide.Shapes.PasteSpecial(DataType:=2).Select
PPApp.ActiveWindow.View.Paste
With PPSlide
.Shapes(1).TextFrame.TextRange.Text = r & " Top 10 TCV New Deals Signed YTD " & Year(Now())
End With
With PPSlide.Shapes(2)
.Top = 70
.Left = 30
.Height = 380
.Width = 660
End With
'Slide 9
LRow = Pivots.Range("BG1").End(xlDown).Row
Pivots.Range("BD1:BG" & LRow).Copy
Set PPSlide = PPPres.Slides(9)
PPApp.ActiveWindow.View.GotoSlide (9)
'PPSlide.Shapes.PasteSpecial(DataType:=2).Select
PPApp.ActiveWindow.View.Paste
With PPSlide
.Shapes(1).TextFrame.TextRange.Text = r & " IR – Top 10 Customers YTD " & Year(Now())
End With
With PPSlide.Shapes(2)
.Top = 70
.Left = 30
.Height = 380
.Width = 660
End With
Application.Wait (Now + TimeValue("00:00:05"))
'Slide 10
Pivots.ChartObjects(11).Copy
i = Pivots.Range("CZ19").Text
j = Pivots.Range("DA19").Text
Set PPSlide = PPPres.Slides(10)
With PPSlide
.Shapes(1).TextFrame.TextRange.Text = r & " New IIR YTD " & Year(Now()) - 1 & " and " & Year(Now()) & " - by Sales Sector"
.Shapes(2).TextFrame.TextRange.Text = "Totals:" & Year(Now()) - 1 & ":" & i & "" & Year(Now()) & ":" & j
End With
PPApp.ActiveWindow.View.GotoSlide (10)
PPSlide.Shapes.PasteSpecial(DataType:=ppPasteDefault).Select
'PPApp.ActiveWindow.View.Paste
With PPSlide.Shapes(3)
.Top = 55
.Left = 85
.Height = 350
.Width = 550
With .Chart.SeriesCollection(1).Format.Fill
.TwoColorGradient 2, 1
.ForeColor.RGB = RGB(0, 94, 140)
.BackColor.RGB = RGB(0, 165, 241)
.GradientStops.Insert RGB(0, 138, 202), 0.5
End With
With .Chart.SeriesCollection(2).Format.Fill
.TwoColorGradient 2, 1
.ForeColor.RGB = RGB(85, 85, 85)
.BackColor.RGB = RGB(125, 125, 125)
.GradientStops.Insert RGB(150, 150, 150), 0.5
End With
End With
'Slide 11
Pivots.ChartObjects(5).Copy
Set PPSlide = PPPres.Slides(11)
LRow = Pivots.Range("BK:BO").Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
i = Pivots.Range("BL" & LRow).Text
j = Pivots.Range("BM" & LRow).Text
k = Pivots.Range("BN" & LRow).Text
l = Pivots.Range("BO" & LRow).Text
PPApp.ActiveWindow.View.GotoSlide (11)
With PPSlide
.Shapes(1).TextFrame.TextRange.Text = r & " Monthly Net MRC YTD " & Year(Now())
With .Shapes(2)
.TextFrame.TextRange.Text = "MRC Won " & Year(Now()) & " YTD: € " & i
.Top = 5
.Left = 475
.Height = 30
.Width = 250
End With
With .Shapes(3)
.TextFrame.TextRange.Text = "MRC Ceased " & Year(Now()) & " YTD: € " & j
.Top = 20
.Left = 475
.Height = 30
.Width = 250
End With
With .Shapes(4)
.TextFrame.TextRange.Text = "MRC Erosion " & Year(Now()) & " YTD: € " & k
.Top = 35
.Left = 475
.Height = 30
.Width = 250
End With
With .Shapes(5)
.TextFrame.TextRange.Text = "Net MRC " & Year(Now()) & " YTD: € " & l
.Top = 50
.Left = 475
.Height = 30
.Width = 250
End With
End With
PPApp.ActiveWindow.View.Paste
With PPSlide.Shapes(6)
.Top = 80
.Left = 30
.Height = 380
.Width = 650
With .Chart
.ChartStyle = 2
.SeriesCollection(1).Format.Fill.ForeColor.RGB = RGB(146, 208, 80)
.SeriesCollection(2).Format.Fill.ForeColor.RGB = RGB(255, 0, 0)
.SeriesCollection(3).Format.Fill.ForeColor.RGB = RGB(246, 139, 31)
.SeriesCollection(4).Format.Fill.ForeColor.RGB = RGB(51, 51, 255)
End With
End With
'Slide 12
LRow = Pivots.Range("BR1").End(xlDown).Row
Pivots.Range("BR1:BW" & LRow).Copy
Set PPSlide = PPPres.Slides(12)
PPApp.ActiveWindow.View.GotoSlide (12)
'PPSlide.Shapes.PasteSpecial(DataType:=2).Select
PPApp.ActiveWindow.View.Paste
With PPSlide
.Shapes(1).TextFrame.TextRange.Text = r & " Net MRC - Top 10 Customer YTD " & Year(Now())
End With
With PPSlide.Shapes(2)
.Top = 70
.Left = 30
.Height = 380
.Width = 660
End With
Application.Wait (Now + TimeValue("00:00:05"))
'Slide 13
Pivots.ChartObjects(6).Copy
Set PPSlide = PPPres.Slides(13)
PPApp.ActiveWindow.View.GotoSlide (13)
With PPSlide
.Shapes(1).TextFrame.TextRange.Text = r & " Revenue at Risk – MRC up for renewal"
End With
PPApp.ActiveWindow.View.Paste
With PPSlide.Shapes(2)
.Top = 50
.Left = 30
.Height = 420
.Width = 650
.Chart.ChartStyle = 8
End With
'Slide 14
Pivots.ChartObjects(7).Copy
Set PPSlide = PPPres.Slides(14)
PPApp.ActiveWindow.View.GotoSlide (14)
With PPSlide
.Shapes(1).TextFrame.TextRange.Text = r & " Revenue at Risk – Top 10 MRC up for renewal " & Year(Now())
End With
PPApp.ActiveWindow.View.Paste
With PPSlide.Shapes(2)
.Top = 50
.Left = 30
.Height = 420
.Width = 650
.Chart.ChartStyle = 8
End With
'Slide 15
Pivots.ChartObjects(8).Copy
Set PPSlide = PPPres.Slides(15)
i = Year(DateSerial(Year(Now()), Month(Now()), Day(Now())))
j = Month(DateSerial(Year(Now()), Month(Now()), Day(Now())))
PPApp.ActiveWindow.View.GotoSlide (15)
With PPSlide
.Shapes(1).TextFrame.TextRange.Text = r & " – Top 5 MRC expiring " & Left(MonthName(j), 3) & "-" & i
End With
PPApp.ActiveWindow.View.Paste
With PPSlide.Shapes(2)
.Top = 50
.Left = 30
.Height = 370
.Width = 650
.Chart.ChartStyle = 8
End With
Application.Wait (Now + TimeValue("00:00:05"))
'Slide 16
Pivots.ChartObjects(9).Copy
Set PPSlide = PPPres.Slides(16)
i = Year(DateSerial(Year(Now()), Month(Now()) + 1, Day(Now())))
j = Month(DateSerial(Year(Now()), Month(Now()) + 1, Day(Now())))
PPApp.ActiveWindow.View.GotoSlide (16)
With PPSlide
.Shapes(1).TextFrame.TextRange.Text = r & " – Top 5 MRC expiring " & Left(MonthName(j), 3) & "-" & i
End With
PPApp.ActiveWindow.View.Paste
With PPSlide.Shapes(2)
.Top = 50
.Left = 30
.Height = 370
.Width = 650
.Chart.ChartStyle = 8
End With
'Slide 17
Pivots.ChartObjects(10).Copy
Set PPSlide = PPPres.Slides(17)
i = Year(DateSerial(Year(Now()), Month(Now()) + 2, Day(Now())))
j = Month(DateSerial(Year(Now()), Month(Now()) + 2, Day(Now())))
PPApp.ActiveWindow.View.GotoSlide (17)
With PPSlide
.Shapes(1).TextFrame.TextRange.Text = r & " – Top 5 MRC expiring " & Left(MonthName(j), 3) & "-" & i
End With
PPApp.ActiveWindow.View.Paste
With PPSlide.Shapes(2)
.Top = 50
.Left = 30
.Height = 370
.Width = 650
.Chart.ChartStyle = 8
End With
'Slide 18
Pivots.Range("FJ1:FO11").Copy
Set PPSlide = PPPres.Slides(18)
PPApp.ActiveWindow.View.GotoSlide (18)
PPApp.ActiveWindow.View.Paste
With PPSlide.Shapes(1)
.TextFrame.TextRange.Text = r & ": SalesForce Pipeline & Top Deals"
.Left = 100
.Top = 10
.Height = 50
.Width = 650
End With
Pivots.Range("SalesForceTable2").Copy
PPApp.ActiveWindow.View.Paste
With PPSlide.Shapes(2)
.Top = 130
.Left = 30
.Height = 320
.Width = 660
End With
With PPSlide.Shapes(3)
.Top = 70
.Left = 30
.Height = 50
.Width = 660
End With
Application.Wait (Now + TimeValue("00:00:05"))
'Slide 19
LRow = Pivots.Range("EC1").End(xlDown).Row
If LRow < 19 Then
Pivots.Range("EC1:EL" & LRow).Copy
Else
Pivots.Range("EC1:EL19").Copy
End If
Set PPSlide = PPPres.Slides(19)
PPApp.ActiveWindow.View.GotoSlide (19)
'PPSlide.Shapes.PasteSpecial(DataType:=2).Select
PPApp.ActiveWindow.View.Paste
With PPSlide.Shapes(1)
.TextFrame.TextRange.Text = r & " Individual Performance YTD " & Year(Now()) & " (pg1)"
.Left = 20
.Top = 20
.Height = 50
.Width = 650
End With
With PPSlide.Shapes(2)
.Top = 70
.Left = 30
.Height = 380
.Width = 660
End With
'Slide 20
If LRow > 19 Then
Pivots.Range("EM2:EV20").ClearContents
If LRow > 19 And LRow <= 37 Then
Pivots.Range("EC20:EL" & LRow).Copy
Else
Pivots.Range("EC20:EL37").Copy
End If
Pivots.Range("EM2").PasteSpecial xlValues
LRow2 = Pivots.Range("EM1").End(xlDown).Row
Columns("EM:EV").EntireColumn.AutoFit
Pivots.Range("EM1:EV" & LRow2).Copy
Set PPLayout = PPPres.Slides(19).CustomLayout
Set PPSlide = PPPres.Slides.AddSlide(20, PPLayout)
Set PPSlide = PPPres.Slides(20)
With PPSlide
.Shapes(2).Delete
End With
PPApp.ActiveWindow.View.GotoSlide (20)
PPApp.ActiveWindow.View.Paste
With PPSlide.Shapes(1)
.TextFrame.TextRange.Font.Size = 28
.TextFrame.TextRange.Text = r & " Individual Performance YTD " & Year(Now()) & " (pg2)"
.Left = 20
.Top = 20
.Height = 50
.Width = 650
End With
With PPSlide.Shapes(2)
.Top = 70
.Left = 30
.Height = 380
.Width = 660
End With
Else
On Error GoTo ContinueHere
For i = PPApp.Slides.Count To 20 Step -1
PPPres.Slides(i).Delete
Next
On Error GoTo 0
End If
Application.Wait (Now + TimeValue("00:00:05"))
'slide 21
If LRow > 37 Then
Pivots.Range("EM2:EV20").ClearContents
If LRow > 37 And LRow <= 55 Then
Pivots.Range("EC38:EL" & LRow).Copy
Else
Pivots.Range("EC38:EL55").Copy
End If
Pivots.Range("EM2").PasteSpecial xlValues
LRow2 = Pivots.Range("EM1").End(xlDown).Row
Columns("EM:EV").EntireColumn.AutoFit
Pivots.Range("EM1:EV" & LRow2).Copy
Set PPLayout = PPPres.Slides(19).CustomLayout
Set PPSlide = PPPres.Slides.AddSlide(21, PPLayout)
Set PPSlide = PPPres.Slides(21)
With PPSlide
.Shapes(2).Delete
End With
PPApp.ActiveWindow.View.GotoSlide (21)
PPApp.ActiveWindow.View.Paste
With PPSlide.Shapes(1)
.TextFrame.TextRange.Font.Size = 28
.TextFrame.TextRange.Text = r & " Individual Performance YTD " & Year(Now()) & " (pg3)"
.Left = 20
.Top = 20
.Height = 50
.Width = 650
End With
With PPSlide.Shapes(2)
.Top = 70
.Left = 30
.Height = 380
.Width = 660
End With
Else
On Error GoTo ContinueHere
For i = PPApp.Slides.Count To 20 Step -1
PPPres.Slides(i).Delete
Next
On Error GoTo 0
End If
'Slide 22
If LRow > 55 Then
Pivots.Range("EM2:EV20").ClearContents
If LRow > 55 And LRow <= 73 Then
Pivots.Range("EC56:EL" & LRow).Copy
Else
Pivots.Range("EC56:EL73").Copy
End If
Pivots.Range("EM2").PasteSpecial xlValues
LRow2 = Pivots.Range("EM1").End(xlDown).Row
Columns("EM:EV").EntireColumn.AutoFit
Pivots.Range("EM1:EV" & LRow2).Copy
Set PPLayout = PPPres.Slides(19).CustomLayout
Set PPSlide = PPPres.Slides.AddSlide(22, PPLayout)
Set PPSlide = PPPres.Slides(22)
With PPSlide
.Shapes(2).Delete
End With
PPApp.ActiveWindow.View.GotoSlide (22)
PPApp.ActiveWindow.View.Paste
With PPSlide.Shapes(1)
.TextFrame.TextRange.Font.Size = 28
.TextFrame.TextRange.Text = r & " Individual Performance YTD " & Year(Now()) & " (pg4)"
.Left = 20
.Top = 20
.Height = 50
.Width = 650
End With
With PPSlide.Shapes(2)
.Top = 70
.Left = 30
.Height = 380
.Width = 660
End With
Else
On Error GoTo ContinueHere
For i = PPApp.Slides.Count To 20 Step -1
PPPres.Slides(i).Delete
Next
On Error GoTo 0
End If
'slide 23
If LRow > 73 Then
Pivots.Range("EM2:EV20").ClearContents
If LRow > 73 And LRow <= 91 Then
Pivots.Range("EC74:EL" & LRow).Copy
Else
Pivots.Range("EC74:EL91").Copy
End If
Pivots.Range("EM2").PasteSpecial xlValues
LRow2 = Pivots.Range("EM1").End(xlDown).Row
Columns("EM:EV").EntireColumn.AutoFit
Pivots.Range("EM1:EV" & LRow2).Copy
Set PPLayout = PPPres.Slides(19).CustomLayout
Set PPSlide = PPPres.Slides.AddSlide(23, PPLayout)
Set PPSlide = PPPres.Slides(23)
With PPSlide
.Shapes(2).Delete
End With
PPApp.ActiveWindow.View.GotoSlide (23)
PPApp.ActiveWindow.View.Paste
With PPSlide.Shapes(1)
.TextFrame.TextRange.Font.Size = 28
.TextFrame.TextRange.Text = r & " Individual Performance YTD " & Year(Now()) & " (pg5)"
.Left = 20
.Top = 20
.Height = 50
.Width = 650
End With
With PPSlide.Shapes(2)
.Top = 70
.Left = 30
.Height = 380
.Width = 660
End With
Else
On Error GoTo ContinueHere
For i = PPApp.Slides.Count To 20 Step -1
PPPres.Slides(i).Delete
Next
On Error GoTo 0
End If
ContinueHere:
PPApp.ActivePresentation.SaveAs "S:\Commercial Finance\Macros for Standard Reporting\Country Manager Presentation Macro\Outputs\" & r & "\" & Format(Now(), "dd-MM-yyyy") & ".pptm"
PPApp.ActivePresentation.Close
PPApp.Quit
' Clean up
Set PPSlide = Nothing
Set PPPres = Nothing
Set PPApp = Nothing
End Sub
我从你那里了解到它给出的错误是Shapes.PasteSpecial : Invalid request. Clipboard is empty or contains data which may not be pasted here.
问题是剪贴板在调用复制操作后并没有立即准备好粘贴，而是需要一些时间来加载数据。让我们给它时间：
添加包含此代码的小模块：
Option Explicit #If VBA7 Then Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr) 'For 64 Bit Systems #Else Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 'For 32 Bit Systems #End If现在在复制和粘贴语句之间插入以下延迟：
Dim i as Integer For i = 1 To 6 DoEvents() Sleep 500 'milliseconds Next i
这应该给复制操作足够的时间来填充剪贴板。
如果太高或太低，您可以在上面的循环中调整常数"6"。