Ошибка времени выполнения "1004" - копирование диаграмм из Excel в существующую PowerPoint с использованием VBA (2010): один и тот же макрос работает 25% времени
Я пытался скопировать диапазоны и диаграммы в существующий шаблон PowerPoint из Excel 2010. Мне бы хотелось, чтобы вставленные диапазоны и диаграммы были редактируемыми, но пока мне удалось вставить их только как рисунок.
Мой макрос зависает примерно в 75% времени, а в остальное время он работает чисто.
Кроме того, если вы можете сказать мне, как отменить обновление экрана, это было бы здорово. Я не мог заставить "Application.Screenupdating = False" работать.
И я также не смог найти ответ для форматирования текста в качестве валюты при экспорте.
Я получил следующие две ошибки в моем коде:
1) Ошибка времени выполнения: "-2147188160 (80048240)": Shapes.PasteSpecial: неверный запрос. Указанный тип данных недоступен.
2) Ошибка объекта: "1004"
Образец кода:
Sub OpenPP()
Dim ppApp As Object
Dim ppPres As Object
Dim Sld As Object
Set ppApp = CreateObject("powerpoint.application")
ppApp.Presentations.Open Filename:="C:\SamplePath", ReadOnly:=msoTrue
ppApp.Visible = True
Set ppPres = ppApp.ActivePresentation
Set Sld = ppPres.Slides(12)
Sld.Shapes(1).TextFrame.TextRange.Text = "Large Sample Report - Claims Greater than $" & Sheet1.Cells(5, 2)
Set Sld = ppPres.Slides(21)
Sld.Shapes(1).TextFrame.TextRange.Text = Sheet1.Cells(16, 2) & " - Claims Report"
Set Sld = ppPres.Slides(22)
Sld.Shapes(1).TextFrame.TextRange.Text = Sheet1.Cells(17, 2) & " - Claims Report"
Set Sld = ppPres.Slides(26)
Sld.Shapes(1).TextFrame.TextRange.Text = Sheet1.Cells(20, 2) & " - Claims Report"
Dim rng As Range, rng1 As Range, rng2 As Range, rng3 As Range, rng4 As Range, rng5 As Range, rng6 As Range, rng7 As Range, rng8 As Range, rng9 As Range, rng10 As Range, rng11 As Range, rng12 As Range, rng13 As Range, rng14 As Range, rng15 As Range, rng16 As Range, rng17 As Range, rng18 As Range
Dim cht1 As Object
Dim cht2 As Object
Dim cht3 As Object
Dim cht4 As Object
Dim cht5 As Object
Dim cht6 As Object
Dim cht7 As Object
Dim cht8 As Object
Set ppApp = GetObject(Class:="PowerPoint.Application")
Set ppPres = ppApp.ActivePresentation
Set rng = Sheet18.Range("A1:D5")
Set rng1 = Sheet18.Range("A7:D11")
Set rng2 = Sheet18.Range("A13:D17")
Set rng3 = Sheet6.Range("A2:O21")
Set rng4 = Sheet7.Range("A2:O21")
Set rng5 = Sheet8.Range("A2:O21")
Set rng6 = Sheet9.Range("A2:O21")
Set rng7 = Sheet10.Range("A2:O21")
Set rng8 = Sheet11.Range("A2:O21")
Set rng9 = Sheet12.Range("A2:O21")
Set rng10 = Sheet13.Range("A2:O20")
Set rng11 = Sheet14.Range("A2:O20")
Set rng12 = Sheet15.Range("A2:O20")
Set rng13 = Sheet16.Range("A2:O20")
Set rng14 = Sheet5.Range("A2:D18")
Set cht1 = Sheet17.ChartObjects("Sample1")
Set cht2 = Sheet17.ChartObjects("Sample2")
Set cht3 = Sheet17.ChartObjects("Sample3")
Set cht4 = Sheet17.ChartObjects("Sample4")
Set cht5 = Sheet17.ChartObjects("Sample5")
Set cht6 = Sheet17.ChartObjects("Sample6")
Set cht7 = Sheet17.ChartObjects("Sample7")
Set cht8 = Sheet17.ChartObjects("sample8")
Set rng15 = Sheet18.Cells(20, 1)
Set rng16 = Sheet18.Cells(21, 1)
Set rng17 = Sheet18.Cells(22, 1)
Set rng18 = Sheet18.Cells(23, 1)
ppPres.Windows(1).Activate
Set Sld = ppPres.Slides(3)
rng15.Copy
ppPres.Windows(1).View.GotoSlide 3
Set x = ppPres.Slides(3).Shapes.PasteSpecial(DataType:=2)
With x
.LockAspectRatio = 1
.Width = 75
.Top = 165
.Left = 440
.Height = 120
End With
Set Sld = ppPres.Slides(3)
rng16.Copy
ppPres.Windows(1).View.GotoSlide 3
Set x = ppPres.Slides(3).Shapes.PasteSpecial(DataType:=2)
With x
.LockAspectRatio = 1
.Width = 75
.Top = 165
.Left = 220
.Height = 120
End With
Set Sld = ppPres.Slides(3)
rng17.Copy
ppPres.Windows(1).View.GotoSlide 3
Set x = ppPres.Slides(3).Shapes.PasteSpecial(DataType:=2)
With x
.LockAspectRatio = 1
.Width = 75
.Top = 165
.Left = 10
.Height = 120
End With
Set Sld = ppPres.Slides(3)
rng18.Copy
ppPres.Windows(1).View.GotoSlide 3
Set x = ppPres.Slides(3).Shapes.PasteSpecial(DataType:=2)
With x
.LockAspectRatio = 1
.Width = 75
.Top = 165
.Left = 650
.Height = 120
End With
Set Sld = ppPres.Slides(4)
rng.Copy
ppPres.Windows(1).View.GotoSlide 4
Set x = ppPres.Slides(4).Shapes.PasteSpecial(DataType:=2)
With x
.LockAspectRatio = 1
.Width = (ppPres.PageSetup.SlideWidth - 40)
.Top = 120
.Left = 20
End With
Set Sld = ppPres.Slides(5)
rng3.Copy
ppPres.Windows(1).View.GotoSlide 5
Set x = ppPres.Slides(5).Shapes.PasteSpecial(DataType:=2)
With x
.LockAspectRatio = 1
.Width = (ppPres.PageSetup.SlideWidth - 40)
.Top = 120
.Left = 20
End With
Set Sld = ppPres.Slides(6)
rng4.Copy
ppPres.Windows(1).View.GotoSlide 6
Set x = ppPres.Slides(6).Shapes.PasteSpecial(DataType:=2)
With x
.LockAspectRatio = 1
.Width = (ppPres.PageSetup.SlideWidth - 40)
.Top = 120
.Left = 20
End With
Set Sld = ppPres.Slides(7)
rng5.Copy
ppPres.Windows(1).View.GotoSlide 7
Set x = ppPres.Slides(7).Shapes.PasteSpecial(DataType:=2)
With x
.LockAspectRatio = 1
.Width = (ppPres.PageSetup.SlideWidth - 40)
.Top = 120
.Left = 20
End With
Set Sld = ppPres.Slides(8)
rng6.Copy
ppPres.Windows(1).View.GotoSlide 8
Set x = ppPres.Slides(8).Shapes.PasteSpecial(DataType:=2)
With x
.LockAspectRatio = 1
.Width = (ppPres.PageSetup.SlideWidth - 40)
.Top = 120
.Left = 20
End With
Set Sld = ppPres.Slides(9)
rng7.Copy
ppPres.Windows(1).View.GotoSlide 9
Set x = ppPres.Slides(9).Shapes.PasteSpecial(DataType:=2)
With x
.LockAspectRatio = 1
.Width = (ppPres.PageSetup.SlideWidth - 40)
.Top = 120
.Left = 20
End With
Set Sld = ppPres.Slides(10)
rng8.Copy
ppPres.Windows(1).View.GotoSlide 10
Set x = ppPres.Slides(10).Shapes.PasteSpecial(DataType:=2)
With x
.LockAspectRatio = 1
.Width = (ppPres.PageSetup.SlideWidth - 40)
.Top = 120
.Left = 20
End With
Set Sld = ppPres.Slides(11)
rng9.Copy
ppPres.Windows(1).View.GotoSlide 11
Set x = ppPres.Slides(11).Shapes.PasteSpecial(DataType:=2)
With x
.LockAspectRatio = 1
.Width = (ppPres.PageSetup.SlideWidth - 40)
.Top = 120
.Left = 20
End With
Set Sld = ppPres.Slides(12)
rng14.Copy
ppPres.Windows(1).View.GotoSlide 12
Set x = ppPres.Slides(12).Shapes.PasteSpecial(DataType:=2)
With x
.LockAspectRatio = 1
.Width = 740
.Top = 110
.Left = 110
End With
Set Sld = ppPres.Slides(13)
cht3.Copy
ppPres.Windows(1).View.GotoSlide 13
Set x = ppPres.Slides(13).Shapes.PasteSpecial(DataType:=11)
With x
.LockAspectRatio = 1
.Width = (ppPres.PageSetup.SlideWidth - 40)
.Top = 100
.Left = 20
End With
Set Sld = ppPres.Slides(14)
cht4.Copy
ppPres.Windows(1).View.GotoSlide 14
Set x = ppPres.Slides(14).Shapes.PasteSpecial(DataType:=11)
With x
.LockAspectRatio = 1
.Width = 400
.Top = 120
.Left = 60
End With
Set Sld = ppPres.Slides(14)
cht5.Copy
ppPres.Windows(1).View.GotoSlide 14
Set x = ppPres.Slides(14).Shapes.PasteSpecial(DataType:=11)
With x
.LockAspectRatio = 1
.Width = 400
.Top = 120
.Left = 500
End With
Set Sld = ppPres.Slides(15)
cht2.Copy
ppPres.Windows(1).View.GotoSlide 15
Set x = ppPres.Slides(15).Shapes.PasteSpecial(DataType:=11)
With x
.LockAspectRatio = 1
.Width = (ppPres.PageSetup.SlideWidth - 40)
.Top = 100
.Left = 20
End With
Set Sld = ppPres.Slides(16)
cht1.Copy
ppPres.Windows(1).View.GotoSlide 16
Set x = ppPres.Slides(16).Shapes.PasteSpecial(DataType:=11)
With x
.LockAspectRatio = 1
.Width = (ppPres.PageSetup.SlideWidth - 40)
.Top = 100
.Left = 20
End With
Set Sld = ppPres.Slides(17)
cht6.Copy
ppPres.Windows(1).View.GotoSlide 17
Set x = ppPres.Slides(17).Shapes.PasteSpecial(DataType:=11)
With x
.LockAspectRatio = 1
.Width = (ppPres.PageSetup.SlideWidth - 400)
.Top = 120
.Left = 200
End With
Set Sld = ppPres.Slides(19)
rng1.Copy
ppPres.Windows(1).View.GotoSlide 19
Set x = ppPres.Slides(19).Shapes.PasteSpecial(DataType:=2)
With x
.LockAspectRatio = 1
.Width = (ppPres.PageSetup.SlideWidth - 40)
.Top = 120
.Left = 20
End With
Set Sld = ppPres.Slides(20)
rng10.Copy
ppPres.Windows(1).View.GotoSlide 20
Set x = ppPres.Slides(20).Shapes.PasteSpecial(DataType:=2)
With x
.LockAspectRatio = 1
.Width = (ppPres.PageSetup.SlideWidth - 40)
.Top = 120
.Left = 20
End With
Set Sld = ppPres.Slides(21)
rng11.Copy
ppPres.Windows(1).View.GotoSlide 21
Set x = ppPres.Slides(21).Shapes.PasteSpecial(DataType:=2)
With x
.LockAspectRatio = 1
.Width = (ppPres.PageSetup.SlideWidth - 40)
.Top = 120
.Left = 20
End With
Set Sld = ppPres.Slides(22)
rng12.Copy
ppPres.Windows(1).View.GotoSlide 22
Set x = ppPres.Slides(22).Shapes.PasteSpecial(DataType:=2)
With x
.LockAspectRatio = 1
.Width = (ppPres.PageSetup.SlideWidth - 40)
.Top = 120
.Left = 20
End With
Set Sld = ppPres.Slides(23)
cht7.Copy
ppPres.Windows(1).View.GotoSlide 23
Set x = ppPres.Slides(23).Shapes.PasteSpecial(DataType:=11)
With x
.LockAspectRatio = 1
.Width = (ppPres.PageSetup.SlideWidth - 400)
.Top = 120
.Left = 200
End With
Set Sld = ppPres.Slides(25)
rng2.Copy
ppPres.Windows(1).View.GotoSlide 25
Set x = ppPres.Slides(25).Shapes.PasteSpecial(DataType:=2)
With x
.LockAspectRatio = 1
.Width = (ppPres.PageSetup.SlideWidth - 40)
.Top = 120
.Left = 20
End With
Set Sld = ppPres.Slides(26)
rng13.Copy
ppPres.Windows(1).View.GotoSlide 26
Set x = ppPres.Slides(26).Shapes.PasteSpecial(DataType:=2)
With x
.LockAspectRatio = 1
.Width = (ppPres.PageSetup.SlideWidth - 40)
.Top = 120
.Left = 20
End With
Set Sld = ppPres.Slides(27)
cht8.Copy
ppPres.Windows(1).View.GotoSlide 27
Set x = ppPres.Slides(27).Shapes.PasteSpecial(DataType:=11)
With x
.LockAspectRatio = 1
.Width = (ppPres.PageSetup.SlideWidth - 400)
.Top = 120
.Left = 200
End With
Application.CutCopyMode = False
End Sub