Copy Excel to PowerPoint - run-time error '-2147417851 (80010105)'; Method 'PasteSpecial' of obejct 'Shapes' failed

[Mieds]

I am trying to create PowerPoint slides from an access database,
basically the data is queried in access, pasted and formatted into
Excel and then copied into PowerPoint. The program loops through
different data (cities) and create a series of slides based on the
results for each city. When I had a small number of cities (35) the
program worked fine, now that I increased the number of cities (160)
the program fails, I get a run-time error '-2147417851 (80010105)';
Method 'PasteSpecial' of obejct 'Shapes' failed

Here is a snippet of the code and where it is failing, after looping
through about 90 times the program fails on the last section,
objPPTSlide.Shapes.PasteSpecial(ppPasteEnhancedMetafile).Name =
"SummaryTableOne". Any ideas or advice would be greatly appreciated.

Option Compare Database

Option Explicit

Sub CreateSlides()

Dim datDate0, datDate1, datDate2, datDate3 As Date

Dim intCurrentSheet, intDMACount, intStartCopy, intEndCopy As
Integer

Dim db As DAO.Database

DoCmd.SetWarnings False

gstrPath = "C:\USER\Data\"

'Create Application Variables

'*Excel

Dim xlApp As Excel.Application

Dim xlWorkbookC As Excel.Workbook

Dim xlWorkbookTemp As Excel.Workbook

Dim xlSheetSlide0, xlSheetSlide1, xlSheetSlide2, xlSheetSlide2U,
xlSheetSlide3, xlSheetSlideTemp As Excel.Worksheet

'*Powerpoint

Dim objPPTApp As PowerPoint.Application

Dim objPPTPresen As PowerPoint.Presentation

Dim objPPTSlide As PowerPoint.Slide

Dim objPPTShape As PowerPoint.Shape

'Open Excel Application

Set xlApp = CreateObject("Excel.Application")

xlApp.Visible = True

Set xlWorkbookC = xlApp.Workbooks.Open(gstrPath &
"DMATemplate.xlsm")

Set xlSheetSlide0 = xlWorkbookC.Sheets("Page_01")

Set xlSheetSlide1 = xlWorkbookC.Sheets("Slides")

Set xlSheetSlide2 = xlWorkbookC.Sheets("Slide2A")

Set xlSheetSlide2U = xlWorkbookC.Sheets("Slide2B")

Set xlSheetSlide3 = xlWorkbookC.Sheets("Page_99")

'Open Powerpoint Application

Set objPPTApp = CreateObject("Powerpoint.Application")

objPPTApp.Visible = True

Set objPPTPresen = objPPTApp.Presentations.Open(gstrPath &
"Template.pptm")

With objPPTPresen.Slides

Set objPPTSlide = .Item(1)

End With

'Create Slide 1

With objPPTPresen.Slides

s = objPPTPresen.Slides.Count

Set objPPTSlide = .Add(s, ppLayoutBlank)

End With

'Create Slide1

Set objPPTShape =
objPPTSlide.Shapes.AddTextbox(msoTextOrientationHorizontal, _

Left:=18, Top:=18, Width:=600, Height:=50)

With objPPTShape

.TextFrame.TextRange.Font.Name = "Verdana"

.TextFrame.TextRange.Font.Bold = msoTrue

.TextFrame.TextRange.ParagraphFormat.Alignment = ppAlignLeft

.TextFrame.TextRange.Text = "Advance 12M Sales Growth vs.
Remaining Market"

.TextFrame.TextRange.Lines(1).Font.Size = 18

End With

With objPPTPresen.Slides

s = objPPTPresen.Slides.Count

Set objPPTSlide = .Add(s, ppLayoutBlank)

End With

Set objPPTShape =
objPPTSlide.Shapes.AddTextbox(msoTextOrientationHorizontal, _

Left:=18, Top:=18, Width:=600, Height:=50)

With objPPTShape

.TextFrame.TextRange.Font.Name = "Verdana"

.TextFrame.TextRange.Font.Bold = msoTrue

.TextFrame.TextRange.ParagraphFormat.Alignment =
ppAlignLeft

.TextFrame.TextRange.Text = "Advance 12M Sales Growth vs.
Remaining Market"

.TextFrame.TextRange.Lines(1).Font.Size = 18

End With

xlSheetSlide0.Select

xlSheetSlide0.Range(strCopyRange).Copy

objPPTSlide.Shapes.PasteSpecial(ppPasteEnhancedMetafile).Name
= "SummaryTableOne"

With objPPTShape

.ScaleHeight 0.4, msoTrue, msoScaleFromMiddle

.ScaleWidth 0.8, msoTrue, msoScaleFromMiddle

.Top = 75

.Left = 18

End With

[Douglas J Steele]

Don't know whether it's the culprit, but be aware that your declarations
aren't doing what you probably think they are.

VBA doesn't allow "chaining" of declarations.

While the following declaration does declare 4 variables

Dim datDate0, datDate1, datDate2, datDate3 As Date

only datDate3 is a Date variable: the other three are Variants. In order to
declare all four variables as Dates, you must use

Dim datDate0 As Date, datDate1 As Date, datDate2 As Date, datDate3 As Date

or

Dim datDate0 As Date
Dim datDate1 As Date
Dim datDate2 As Date
Dim datDate3 As Date

"Mieds" wrote in message
news:f38b3351-1fa3-4cd5...@o26g2000vby.googlegroups.com...

[priya]

Mieds wrote on 04/13/2011 16:58 ET :
> I am trying to create PowerPoint slides from an access database,
> basically the data is queried in access, pasted and formatted into
> Excel and then copied into PowerPoint. The program loops through
> different data (cities) and create a series of slides based on the
> results for each city. When I had a small number of cities (35) the
> program worked fine, now that I increased the number of cities (160)
> the program fails, I get a run-time error '-2147417851 (80010105)';
> Method 'PasteSpecial' of obejct 'Shapes' failed
>
> Here is a snippet of the code and where it is failing, after looping
> through about 90 times the program fails on the last section,
> objPPTSlide.Shapes.PasteSpecial(ppPasteEnhancedMetafile).Name

> "SummaryTableOne". Any ideas or advice would be greatly appreciated.
>
> Option Compare Database
>
> Option Explicit
>
>
>
> Sub CreateSlides()
>
> Dim datDate0, datDate1, datDate2, datDate3 As Date
>
> Dim intCurrentSheet, intDMACount, intStartCopy, intEndCopy As
> Integer
>
> Dim db As DAO.Database
>
> DoCmd.SetWarnings False
>

> gstrPath = "C:USERData"

> Set objPPTShape objPPTSlide.Shapes.AddTextbox(msoTextOrientationHorizontal, _
>
> Left: , Top: , Width:`0, Height:P)

>
> With objPPTShape
>
> .TextFrame.TextRange.Font.Name = "Verdana"
>
> .TextFrame.TextRange.Font.Bold = msoTrue
>
> .TextFrame.TextRange.ParagraphFormat.Alignment = ppAlignLeft
>
> .TextFrame.TextRange.Text = "Advance 12M Sales Growth vs.
> Remaining Market"
>
> .TextFrame.TextRange.Lines(1).Font.Size = 18
>
> End With
>
>
>
> With objPPTPresen.Slides
>
> s = objPPTPresen.Slides.Count
>
> Set objPPTSlide = .Add(s, ppLayoutBlank)
>
> End With
>
>
>

> Set objPPTShape objPPTSlide.Shapes.AddTextbox(msoTextOrientationHorizontal, _
>
> Left: , Top: , Width:`0, Height:P)

>
> With objPPTShape
>
> .TextFrame.TextRange.Font.Name = "Verdana"
>
> .TextFrame.TextRange.Font.Bold = msoTrue
>

> .TextFrame.TextRange.ParagraphFormat.Alignment ppAlignLeft

>
> .TextFrame.TextRange.Text = "Advance 12M Sales Growth vs.
> Remaining Market"
>
> .TextFrame.TextRange.Lines(1).Font.Size = 18
>
> End With
>
>
>
> xlSheetSlide0.Select
>
> xlSheetSlide0.Range(strCopyRange).Copy
>
>
>
> objPPTSlide.Shapes.PasteSpecial(ppPasteEnhancedMetafile).Name
> = "SummaryTableOne"
>
> With objPPTShape
>
> .ScaleHeight 0.4, msoTrue, msoScaleFromMiddle
>
> .ScaleWidth 0.8, msoTrue, msoScaleFromMiddle
>
> .Top = 75
>
> .Left = 18
>
> End With
>

instead of :
xlSheetSlide0.Range(strCopyRange).Copy
objPPTSlide.Shapes.PasteSpecial(ppPasteEnhancedMetafile).Name
= "SummaryTableOne"

try this:
xlSheetSlide0.Range(strCopyRange).CopyPicture xlScreen, xlPicture
objPPTSlide.Shapes.Paste