VBA当粘贴到Powerpoint时崩溃 [英] VBA Crashing when pasting into Powerpoint

查看：1025 发布时间：2017/9/9 16:38:42 excel vba excel-vba powerpoint

本文介绍了VBA当粘贴到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 
 
设置PPT = CreateObject（PowerPoint.Application）
 PPT.Visible = True 
 
 PPT.Presentations.Open filename：=S：\商业Finance \Macros for Standard Reporting \Country Manager 
设置PPApp = CreateObject（Powerpoint.Application）
设置PPApp = GetObject（Powerpoint.Application）
设置PPPres = PPApp.ActivePresentation 
 
'Slide 1 
设置PPSlide = PPPres.Slides（1）
 PPSlide.Shapes（1）.TextFrame.TextRange.Text = r& 国家评估YTD&年（现在（））
 
'幻灯片2 
设置PPSlide = PPPres.Slides（2）
 PPSlide.Shapes（1）.TextFrame.TextRange.Text = r& 国家评估YTD&年份（现在（））
 
'幻灯片3 
 Pivots.ChartObjects（1）.Copy 
 
i = Pivots.Range（G14）。 $ bj = Pivots.Range（H14）。文本
 
设置PPSlide = PPPres.Slides（3）
 
使用PPSlide 
 .Shapes（1）。 TextFrame.TextRange.Text = r& TCV YTD&年（现（）） -  1& 和&年（现（））&  - 按扇区
 .Shapes（2）.TextFrame.TextRange.Text =总计：&年（现（）） -  1& ：&我& &年（现（））& ：& j 
结束
 PPApp.ActiveWindow.View.GotoSlide（3）
 PPSlide.Shapes.PasteSpecial（DataType：= ppPasteDefault）。选择
'PPApp.ActiveWindow.View.Paste 
与PPSlide.Shapes（3）
 .Top = 55 
 .Left = 85 
 .Height = 350 
 .Width = 550 
带.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 
结束
带.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 
结束
结束
 
 Application.Wait（Now + TimeValue（00:00:05））
 
'幻灯片4 
 Pivots.ChartObjects（2）.Copy 
 
i = Pivots.Range（V14）。文本
j = Pivots.Range（W14）。文本
 
设置PPSlide = PPPres.Slides（4）
 
使用PPSlide 
 .Shapes（1）.TextFrame.TextRange.Text = r& TCV YTD&年（现（）） -  1& 和&年（现（））&  - 按类型
 .Shapes（2）.TextFrame.TextRange.Text =总计：&年（现（）） -  1& ：&我& &年（现（））& ：& j 
结束
 PPApp.ActiveWindow.View.GotoSlide（4）
'PPApp.CommandBars.ExecuteMso（PasteSourceFormatting）
 PPSlide.Shapes.PasteSpecial（DataType：= ppPasteDefault ）。选择
使用PPSlide.Shapes（3）
 .Top = 55 
 .Left = 85 
 .Height = 350 
 .Width = 550 
使用.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 
结束
结束
 
'幻灯片5 
 LRow = Pivots.Range（AH8）。End（xlDown）.Row 
 Pivots.Range（AH8：AI& LRow）.Copy 
 
设置PPSlide = PPPres.Slides（5）
 
 P （2）
 .Top = 70 
 .Left = 50 
 .Height = 400 
 .Width = 200 
结束
 
 Pivots.ChartObjects（3）.Copy 
 
 PPApp.ActiveWindow.View。 GotoSlide（5）
使用PPSlide 
 .Shapes（1）.TextFrame.TextRange.Text = r& 新年快讯年（现在（））
结束
 PPApp.ActiveWindow.View.Paste 
与PPSlide.Shapes（3）
 .Top = 80 
 .Left = 300 
 .Height = 380 
 .Width = 350 
结束
 
'幻灯片6 
 LRow = Pivots.Range（AN8）。End xlDown）.Row 
 Pivots.Rows（8：& LRow）.RowHeight = 20 
 Pivots.Range（AN8：AO& LRow）.Copy 
 
设置PPSlide = PPPres.Slides（6）
 
 PPApp.ActiveWindow.View.GotoSlide（6）
 PPApp.ActiveWindow.View.Paste 
使用PPSlide.Shapes（2） 
 .Top = 70 
 .Left = 50 
 .Height = 380 
 .Width = 200 
结束
 
 Pivots.ChartObjects 4）.Copy 
 
 PPApp.ActiveWindow.View.GotoSlide（6）
使用PPSlide 
 .Shapes（1）.TextFrame.TextRange.Text = r& 新产品新TCV&年（现在（））
结束
 PPApp.ActiveWindow.View.Paste 
与PPSlide.Shapes（3）
 .Top = 80 
 .Left = 300 
 .Height = 380 
 .Width = 350 
结束
 
 Application.Wait（Now + TimeValue（00:00:05））
 
'Slide 7 
 LRow = Pivots.Range（AY8）。End（xlDown）.Row 
 Pivots.Range（AT1：AZ& LRow）.Copy 
 
设置PPSlide = PPPres.Slides（7）
 
 PPApp.ActiveWindow.View.GotoSlide（7）
'PPSlide.Shapes.PasteSpecial（DataType：= 2）。选择
 PPApp.ActiveWindow.View.Paste 
使用PPSlide 
 .Shapes（1）.TextFrame.TextRange.Text = r& 十佳TCV新交易签署YTD&年份（现在（））
结束
 
与PPSlide.Shapes（2）
 .Top = 70 
 .Left = 30 
 .Height = 380 
 .Width = 660 
结束
 
'幻灯片9 
 LRow = Pivots.Range（BG1）。End（xlDown）.Row 
 Pivots.Range（BD1：BG& LRow）.Copy 
 
设置PPSlide = PPPres.Slides（9）
 
 PPApp.ActiveWindow.View.GotoSlide（9 ）
'PPSlide.Shapes.PasteSpecial（DataType：= 2）。选择
 PPApp.ActiveWindow.View.Paste 
使用PPSlide 
 .Shapes（1）.TextFrame.TextRange。 Text = r& 红十字会 - 十佳客户年年年份（现在（））
结束
 
与PPSlide.Shapes（2）
 .Top = 70 
 .Left = 30 
 .Height = 380 
 .Width = 660 
结束
 
 Application.Wait（Now + TimeValue（00:00:05））
 
'幻灯片10 
 Pivots.ChartObjects（11）.Copy 
 
i = Pivots.Range（CZ19）。文本
j = Pivots.Range（DA19）。文本
 
设置PPSlide = PPPres.Slides（10）
 
使用PPSlide 
 .Shapes（1）.TextFrame.TextRange.Text = r& 新的IIR YTD&年（现（）） -  1& 和&年（现（））&  - 按销售部门
 .Shapes（2）.TextFrame.TextRange.Text =总计：&年（现（）） -  1& ：&我& &年（现（））& ：& j 
结束
 PPApp.ActiveWindow.View.GotoSlide（10）
 PPSlide.Shapes.PasteSpecial（DataType：= ppPasteDefault）。选择
'PPApp.ActiveWindow.View.Paste 
与PPSlide.Shapes（3）
 .Top = 55 
 .Left = 85 
 .Height = 350 
 .Width = 550 
带.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 
结束
带.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 
结束
结束
 
'幻灯片11 
 
 Pivots.ChartObjects（5）.Copy 
 
设置PPSlide = PPPres.Slides（11）
 
 LRow = Pivots.Range（BK：BO）。Find（*，searchorder：= xlByRows，searchdirectio n：= 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）
使用PPSlide 
 .Shapes（1）.TextFrame.TextRange.Text = r& ; 月度净MRC年初至今& Year（Now（））
带.Shapes（2）
 .TextFrame.TextRange.Text =MRC Won&年（现（））& YTD：€& i 
 .Top = 5 
 .Left = 475 
 .Height = 30 
 .Width = 250 
结束
 
带.Shapes （3）
 .TextFrame.TextRange.Text =MRC Ceased&年（现（））& YTD：€& j 
 .Top = 20 
 .Left = 475 
 .Height = 30 
 .Width = 250 
结束
 
带.Shapes （4）
 .TextFrame.TextRange.Text =MRC Erosion&年（现（））& YTD：€& k 
 .Top = 35 
 .Left = 475 
 .Height = 30 
 .Width = 250 
结束
 
带.Shapes （5）
 .TextFrame.TextRange.Text =Net MRC&年（现（））& YTD：€& l 
 .Top = 50 
 .Left = 475 
 .Height = 30 
 .Width = 250 
结束
 
结束与
 PPApp.ActiveWindow.View.Paste 
使用PPSlide.Shapes（6）
 .Top = 80 
 .Left = 30 
 .Height = 380 
。宽度= 650 
带.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）
结束
结束
 
'幻灯片12 
 LRow = Pivots.Range（BR1）。End（xlDown）.Row 
 Pivots.Range（BR1：BW& LRow）.Copy 
 
设置PPSlide = PPPres.Slides 12）
 
 PPApp.ActiveWindow.View.GotoSlide（12）
'PPSlide.Shapes.PasteSpecial（DataType：= 2）。选择
 PPApp.ActiveWindow.View.Paste 
与PPSlide 
。形状（1）.Te xtFrame.TextRange.Text = r& 净MRC  - 十佳客户至上&年份（现在（））
结束
 
与PPSlide.Shapes（2）
 .Top = 70 
 .Left = 30 
 .Height = 380 
 .Width = 660 
结束
 
 Application.Wait（Now + TimeValue（00:00:05））
 
'幻灯片13 
 Pivots.ChartObjects（6）.Copy 
 
设置PPSlide = PPPres.Slides（13）
 
 PPApp.ActiveWindow.View.GotoSlide（13）
使用PPSlide 
 .Shapes（1）.TextFrame.TextRange.Text = r& 风险收益 -  MRC续订
结束
 PPApp.ActiveWindow.View.Paste 
使用PPSlide.Shapes（2）
 .Top = 50 
 .Left = 30 
 .Height = 420 
 .Width = 650 
 .Chart.ChartStyle = 8 
结束
 
'幻灯片14 
 Pivots.ChartObjects（7）.Copy 
 
设置PPSlide = PPPres.Slides（14）
 
 PPApp.ActiveWindow.View.GotoSlide（14）
使用PPSlide 
 .Shapes（1）.TextFrame.TextRange.Text = r& 风险收入 - 十大MRC续约&年（现在（））
结束
 PPApp.ActiveWindow.View.Paste 
与PPSlide.Shapes（2）
 .Top = 50 
 .Left = 30 
 .Height = 420 
 .Width = 650 
 .Chart.ChartStyle = 8 
结束
 
'幻灯片15 
 Pivots.ChartObjects （8）.Copy 
 
设置PPSlide = PPPres.Slides（15）
i =年（DateSerial（Year（Now（）），Month（Now（）），Day（Now（） ））
j = Month（DateSerial（Year（Now（）），Month（Now（）），Day（Now（））））
 PPApp.ActiveWindow.View.GotoSlide（15）
使用PPSlide 
 .Shapes（1）.TextFrame.TextRange.Text = r&  - 前5名MRC到期&左（月名（j），3）&  - & i 
结束
 PPApp.ActiveWindow.View.Paste 
与PPSlide.Shapes（2）
 .Top = 50 
 .Left = 30 
。 Height = 370 
 .Width = 650 
 .Chart.ChartStyle = 8 
结束
 
 Application.Wait（Now + TimeValue（00:00:05 ）
 
'Slide 16 
 Pivots.ChartObjects（9）.Copy 
 
设置PPSlide = PPPres.Slides（16）
i =年份（DateSerial （Year（Now（）），Month（Now（））+ 1，Day（Now（））））
j = Month（DateSerial Day（Now（））））
 PPApp.ActiveWindow.View.GotoSlide（16）
使用PPSlide 
 .Shapes（1）.TextFrame.TextRange.Text = r&  - 前5名MRC到期&左（月名（j），3）&  - & i 
结束
 PPApp.ActiveWindow.View.Paste 
与PPSlide.Shapes（2）
 .Top = 50 
 .Left = 30 
。高度= 370 
 .Width = 650 
 .Chart.ChartStyle = 8 
结束
 
'幻灯片17 
 Pivots.ChartObjects（10）.Copy 
 
设置PPSlide = PPPres.Slides（17）
i =年（DateSerial（Year（Now（）），Month（Now（））+ 2，Day（Now（））） 
j = Month（DateSerial（Year（Now（）），Month（Now（））+ 2，Day（Now（））））
 PPApp.ActiveWindow.View.GotoSlide（17）
使用PPSlide 
 .Shapes（1）.TextFrame.TextRange.Text = r&  - 前5名MRC到期&左（月名（j），3）&  - & i 
结束
 PPApp.ActiveWindow.View.Paste 
与PPSlide.Shapes（2）
 .Top = 50 
 .Left = 30 
。高度= 370 
 .Width = 650 
 .Chart.ChartStyle = 8 
结束
 
'幻灯片18 
 Pivots.Range（FJ1：FO11 ）.Copy 
 
设置PPSlide = PPPres.Slides（18）
 
 PPApp.ActiveWindow.View.GotoSlide（18）
 PPApp.ActiveWindow.View.Paste 
与PPSlide.Shapes（1）
 .TextFrame.TextRange.Text = r& ：SalesForce Pipeline& Top Deals
 .Left = 100 
 .Top = 10 
 .Height = 50 
 .Width = 650 
结束
 
 Pivots.Range（SalesForceTable2）。复制
 PPApp.ActiveWindow.View.Paste 
 
使用PPSlide.Shapes（2）
 .Top = 130 
 .Left = 30 
 .Height = 320 
 .Width = 660 
结束与
 
与PPSlide.Shapes（3）
 .Top = 70 
 .Left = 30 
 .Height = 50 
 .Width = 660 
结束
 
 Application.Wait（Now + TimeValue（00 ：00：05））
 
'幻灯片19 
 LRow = Pivots.Range（EC1）。End（xlDown）.Row 
 
如果LRow< ; 19然后
 Pivots.Range（EC1：EL& LRow）.Copy 
 Else 
 Pivots.Range（EC1：EL19）。复制
 End If 
 
设置PPSlide = PPPres.Slides（19）
 
 PPApp.ActiveWindow.View.GotoSlide（19）
'PPSlide.Shapes.PasteSpecial（DataType：= 2）。选择
 PPApp.ActiveWindow.View.Paste 
使用PPSlide.Shapes（1）
 .TextFrame.TextRange.Text = r& 个人表现YTD&年（现（））& （pg1）
 .Left = 20 
 .Top = 20 
 .Height = 50 
 .Width = 650 
结束
 
 with PPSlide.Shapes（2）
 .Top = 70 
 .Left = 30 
 .Height = 380 
 .Width = 660 
结束
 
'幻灯片20 
如果LRow> 19然后
 
 Pivots.Range（EM2：EV20）。ClearContents 
 
如果LRow> 19和LRow< = 37然后
 Pivots.Range（EC20：EL& LRow）.Copy 
 Else 
 Pivots.Range（EC20：EL37）。复制
如果
 
 Pivots.Range（EM2）。PasteSpecial xlValues 
 
 LRow2 = Pivots.Range（EM1）。End（xlDown）.Row 
 
列（EM：EV）。EntireColumn.AutoFit 
 
 Pivots.Range（EM1：EV& LRow2）.Copy 
 
设置PPLayout = PPPres.Slides（19）.CustomLayout 
设置PPSlide = PPPres.Slides.AddSlide（20，PPLayout）
设置PPSlide = PPPres.Slides（20）
 
使用PPSlide 
 .Shapes（2）.Delete 
结束
 
 PPApp.ActiveWindow.View.GotoSlide（20）
 PPApp.ActiveWindow.View.Paste 
使用PPSlide.Shapes（1）
 .TextFrame.TextRange.Font.Size = 28 
 .TextFrame.TextRange.Text = r& 个人表现YTD&年（现（））& （pg2）
 .Left = 20 
 .Top = 20 
 .Height = 50 
 .Width = 650 
结束
 
 with PPSlide.Shapes（2）
 .Top = 70 
 .Left = 30 
 .Height = 380 
 .Width = 660 
结束
 
 Else 
 
错误GoTo ContinueHere 
 
对于i = PPApp.Slides.Count到20步-1 
 
 PPPres.Slides i）。删除
 
下一个
 
错误GoTo 0 
 
如果
 
 Application.Wait（Now + TimeValue （00:00:05））
 
'slide 21 
如果LRow> 37然后
 
 Pivots.Range（EM2：EV20）。ClearContents 
 
如果LRow> 37和LRow <= 55然后
 Pivots.Range（EC38：EL& LRow）.Copy 
 Else 
 Pivots.Range（EC38：EL55）。复制
如果
 
 Pivots.Range（EM2）。PasteSpecial xlValues 
 
 LRow2 = Pivots.Range（EM1）。End（xlDown）.Row 
 
列（EM：EV）。EntireColumn.AutoFit 
 
 Pivots.Range（EM1：EV& LRow2）.Copy 
 
设置PPLayout = PPPres.Slides（19）.CustomLayout 
设置PPSlide = PPPres.Slides.AddSlide（21，PPLayout）
设置PPSlide = PPPres.Slides（21）
 
使用PPSlide 
 .Shapes（2）.Delete 
 End with 
 
 PPApp.ActiveWindow.View.GotoSlide（21）
 PPApp.ActiveWindow.View.Paste 
使用PPSlide.Shapes（1）
 .TextFrame.TextRange.Font.Size = 28 
 .TextFrame.TextRange.Text = r& 个人表现YTD&年（现（））& （pg3）
 .Left = 20 
 .Top = 20 
 .Height = 50 
 .Width = 650 
结束
 
 with PPSlide.Shapes（2）
 .Top = 70 
 .Left = 30 
 .Height = 380 
 .Width = 660 
结束
 
 Else 
 
错误GoTo ContinueHere 
 
对于i = PPApp.Slides.Count到20步-1 
 
 PPPres.Slides i）。删除
 
下一个
 
错误GoTo 0 
 
结束如果
 
'幻灯片22 
如果LRow> 55然后
 
 Pivots.Range（EM2：EV20）。ClearContents 
 
如果LRow> 55和LRow <= 73然后
 Pivots.Range（EC56：EL& LRow）.Copy 
 Else 
 Pivots.Range（EC56：EL73）。复制
如果
 
 Pivots.Range（EM2）。PasteSpecial xlValues 
 
 LRow2 = Pivots.Range（EM1）。End（xlDown）.Row 
 
列（EM：EV）。EntireColumn.AutoFit 
 
 Pivots.Range（EM1：EV& LRow2）.Copy 
 
设置PPLayout = PPPres.Slides（19）.CustomLayout 
设置PPSlide = PPPres.Slides.AddSlide（22，PPLayout）
设置PPSlide = PPPres.Slides（22）
 
使用PPSlide 
 .Shapes（2）.Delete 
 End with 
 
 PPApp.ActiveWindow.View.GotoSlide（22）
 PPApp.ActiveWindow.View.Paste 
使用PPSlide.Shapes（1）
 .TextFrame.TextRange.Font.Size = 28 
 .TextFrame.TextRange.Text = r& 个人表现YTD&年（现（））& （pg4）
 .Left = 20 
 .Top = 20 
 .Height = 50 
 .Width = 650 
结束
 
 with PPSlide.Shapes（2）
 .Top = 70 
 .Left = 30 
 .Height = 380 
 .Width = 660 
结束
 
 Else 
 
错误GoTo ContinueHere 
 
对于i = PPApp.Slides.Count到20步-1 
 
 PPPres.Slides i）。删除
 
下一个
 
错误GoTo 0 
 
如果
 
'slide 23 
如果LRow> 73然后
 
 Pivots.Range（EM2：EV20）。ClearContents 
 
如果LRow> 73和LRow <= 91然后
 Pivots.Range（EC74：EL& LRow）.Copy 
 Else 
 Pivots.Range（EC74：EL91）。复制
如果
 
 Pivots.Range（EM2）。PasteSpecial xlValues 
 
 LRow2 = Pivots.Range（EM1）。End（xlDown）.Row 
 
列（EM：EV）。EntireColumn.AutoFit 
 
 Pivots.Range（EM1：EV& LRow2）.Copy 
 
设置PPLayout = PPPres.Slides（19）.CustomLayout 
设置PPSlide = PPPres.Slides.AddSlide（23，PPLayout）
设置PPSlide = PPPres.Slides（23）
 
使用PPSlide 
 .Shapes（2）.Delete 
 End with 
 
 PPApp.ActiveWindow.View.GotoSlide（23）
 PPApp.ActiveWindow.View.Paste 
使用PPSlide.Shapes（1）
 .TextFrame.TextRange.Font.Size = 28 
 .TextFrame.TextRange.Text = r& 个人表现YTD&年（现（））& （pg5）
 .Left = 20 
 .Top = 20 
 .Height = 50 
 .Width = 650 
结束
 
 with PPSlide.Shapes（2）
 .Top = 70 
 .Left = 30 
 .Height = 380 
 .Width = 660 
结束
 
 Else 
 
错误GoTo ContinueHere 
 
对于i = PPApp.Slides.Count到20步-1 
 
 PPPres.Slides i）。删除
 
下一个
 
错误GoTo 0 
 
结束如果
 
 ContinueHere：
 
 PPApp.ActivePresentation.SaveAsS：\Commercial Finance\Macros for Standard Reporting\Country Manager Presentation Macro\Outputs\& r& \&格式（Now（），dd-MM-yyyy）& .pptm
 PPApp.ActivePresentation.Close 
 PPApp.Quit 
 
'清理
设置PPSlide =没有
设置PPPres = Nothing 
设置PPApp = Nothing 
 
 End Sub

解决方案

我从中学到，它给出的错误是 Shapes.PasteSpecial：无效的请求。剪贴板是空的，或者包含可能未粘贴的数据。

问题是剪贴板在调用复制操作后立即没有准备好粘贴，但需要一些时间才能加载数据。让我们给它一下时间：

添加包含此代码的小模块：

公开声明PtrSafe Sub Sleep Libkernel32（ByVal dwMilliseconds As LongPtr）'对于64位系统
#Else
公共声明Sub Sleep Libkernel32（ByVal dwMilliseconds As Long）'对于32位系统
#End如果

现在在您的复制和粘贴语句之间插入以下延迟：

  Dim i as Integer 
对于i = 1至6 
 DoEvents（）
睡眠500'毫秒
下一步i

这应该给复制操作足够的时间来填充剪贴板。

如果过高或过低，您可以在上述循环中调整常量6。

I have made a macro which creates some graphs in excel and then opens powerpoint and pastes them into a template. Over the past couple of weeks and it has been working completely fine but after adding some things into the macro (which are completely separate things like refreshing data and setting filters) it seems to be crashing when pasting the graphs into powerpoint. Anyone else had similar issues in the past? There doesn't seem to be any reason why it should be doing it at all...

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

解决方案

I learned from you that the error it gives is Shapes.PasteSpecial : Invalid request. Clipboard is empty or contains data which may not be pasted here.

The problem is that clipboard is not ready for pasting immediately after calling copy operation, but it needs some time to load the data. Let's give it the time:

Add small module containing this code:

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

Now insert the following delay between your copy and paste statements:

Dim i as Integer
For i = 1 To 6 
  DoEvents() 
  Sleep 500 'milliseconds
Next i

This should give copy operation enough time to populate the clipboard.

You can adjust constant "6" in the above loop if it is too high or too low.

这篇关于VBA当粘贴到Powerpoint时崩溃的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！

查看全文

VBA当粘贴到Powerpoint时崩溃 [英] VBA Crashing when pasting into Powerpoint

问题描述

相关文章

Office最新文章

热门教程

热门工具

登录关闭

VBA当粘贴到Powerpoint时崩溃 [英] VBA Crashing when pasting into Powerpoint

问题描述

相关文章

Office最新文章

热门教程

热门工具

登录 关闭

登录关闭