Random error with copying Excel to Powerpoint

Question

I have about 20 Excel sheets that I want to consolidate in a PowerPoint presentation. I created a "Master.xlsm" that contains the VBA that copies the Excel tables to the PowerPoint presentation. The VBA is pretty straightforward, but for some reason, I get the following error when a couple of Excel sheets have been read:

Run-time error '1004':

CopyPicture method of Range class failed

The strange thing is, it doesn't happen at the same point every time. Sometimes the error occurs when there are 3 or 4 Excel sheets copied to the PowerPoint presentation, sometimes it happens near the end, and sometimes the error doesn't occur at all and the process goes fine!

Since it's multiple Excel sheets, I have created a private function that copies and pastes the Excel tables as a picture (The XLSRangeFrom and XLSRangeTo are variables that are passed in the function):

Dim Xapp As New Excel.Application

Dim book As Excel.Workbook

    

Set ppSlide = ppApp.ActivePresentation.Slides(6)

ppSlide.Shapes(1).TextFrame.TextRange.Text = "Powerpoint Slide Title"

    

Set book = Xapp.Workbooks.Add("C:\temp\excel.xls")

book.Worksheets(XLSWorksheet).Activate

book.Worksheets(XLSWorksheet).Range(XLSRangeFrom & ":" & XLSRangeTo).CopyPicture _

            Appearance:=xlScreen, Format:=xlPicture

    With ppSlide

        .Shapes.Paste

        .Shapes.Range(.Shapes.Count).Align msoAlignCenters, True

        .Shapes.Range(.Shapes.Count).Align msoAlignMiddles, True      

    End With

    

    book.Close SaveChanges:=False

    Xapp.Application.Quit

    Xapp.Parent.Quit

    Set Xapp = Nothing

    Set book = Nothing

The error is thrown on the bold marked line.

Can anyone point me in the right direction how I can solve this?

Thanks!

---

-

Answer 1

I have about 20 Excel sheets that I want to consolidate in a PowerPoint presentation. I created a "Master.xlsm" that contains the VBA that copies the Excel tables to the PowerPoint presentation. The VBA is pretty straightforward, but for some reason, I get the following error when a couple of Excel sheets have been read:

Run-time error '1004':

CopyPicture method of Range class failed

The strange thing is, it doesn't happen at the same point every time. Sometimes the error occurs when there are 3 or 4 Excel sheets copied to the PowerPoint presentation, sometimes it happens near the end, and sometimes the error doesn't occur at all and the process goes fine!

Since it's multiple Excel sheets, I have created a private function that copies and pastes the Excel tables as a picture (The XLSRangeFrom and XLSRangeTo are variables that are passed in the function):

Dim Xapp As New Excel.Application

Dim book As Excel.Workbook

    

Set ppSlide = ppApp.ActivePresentation.Slides(6)

ppSlide.Shapes(1).TextFrame.TextRange.Text = "Powerpoint Slide Title"

    

Set book = Xapp.Workbooks.Add("C:\temp\excel.xls")

book.Worksheets(XLSWorksheet).Activate

book.Worksheets(XLSWorksheet).Range(XLSRangeFrom & ":" & XLSRangeTo).CopyPicture _

            Appearance:=xlScreen, Format:=xlPicture

    With ppSlide

        .Shapes.Paste

        .Shapes.Range(.Shapes.Count).Align msoAlignCenters, True

        .Shapes.Range(.Shapes.Count).Align msoAlignMiddles, True      

    End With

    

    book.Close SaveChanges:=False

    Xapp.Application.Quit

    Xapp.Parent.Quit

    Set Xapp = Nothing

    Set book = Nothing

The error is thrown on the bold marked line.

Can anyone point me in the right direction how I can solve this?

Thanks!

---

-

This is the VB.NET forum.  Visit the link below for links to Office and VBA forums:

For VBA, Office (VSTO), Macros and VBScript Questions

:)

---

Doug

SEARCH ... then ask

Answer 2

I think you need to have a look at the values in variables XLSRangeFrom and XLSRangeTo  when the error is thrown

Regards
Shasur

---

http://www.vbadud.blogspot.com

Answer 3

Thanks for your reply. Those seems to be in order though, because the error is thrown really randomly. Sometimes when I run the script again it works perfectly, and then again, I press the Run button again and this error is thrown...

---

-

Answer 4

Hello Erik,

this issue is not easy to reproduce in our side, so, I would like to introduce some method to you to debug the code in your side:

http://pubs.logicalexpressions.com/pub0009/LPMArticle.asp?ID=410
http://www.cpearson.com/excel/Debug.htm

Thanks.

---

Please remember to mark the replies as answers if they help and unmark them if they provide no help.

Answer 5

Hi Erik,

I am also in the same boat.  I am getting randomly below error when copy pictures from Worksheets and paste pictures on PPT.  I have used Application.CutCopyMode = False method to clear clipboards after each paste but I did not luck. 

The error is throwing on the bold marked line in the below code.  Can I know how did you resolve this issue and help me to point the right direction to how I can solve this?

Run-time error '1004':

CopyPicture method of Range class failed

Here is my code...

Sub PPTMedium()
'
' PPTMedium Macro
'
    Dim pptApp As Object
    Dim sTemplatePPt As String
    Dim wks As Worksheet
    Dim fileName As String
    Dim cellName As String
    Dim pathName As String
    Dim saveLoc As String
    Dim loopName As String
    Dim iIndex As Integer
   
    Sheets("AN").Select
    ActiveSheet.Range("A1").Select
    a = Selection.Text
    ActiveSheet.Range("A10").Select
    b = Selection.Text
    ActiveSheet.Range("A4").Select
    cellName = Selection.Text
    ActiveSheet.Range("A11").Select
    loopName = Selection.Text
    Sheets("AN").Select

    iIndex = 0
    Set pptApp = CreateObject("Powerpoint.Application")
    With pptApp
        .Visible = True
        .Presentations.Open _
            fileName:=sTemplatePPt, Untitled:=msoTrue
        For Each wks In Worksheets
            wks.Select
            .ActiveWindow.View.gotoslide _
                Index:=.ActivePresentation.Slides.Add _
                (Index:=5 + iIndex, Layout:=11).SlideIndex
            iIndex = iIndex + 1
           
            .ActiveWindow.Selection.SlideRange.Shapes(1).Select
            .ActiveWindow.Selection.ShapeRange.IncrementLeft -18#
            .ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Select
            If a = "O" Then
                '.ActiveWindow.Selection.ShapeRange.Top = 50
                .ActiveWindow.Selection.ShapeRange.Top = 30
                .ActiveWindow.Selection.ShapeRange.Left = 28
                .ActiveWindow.Selection.ShapeRange.Height = 36
            ElseIf a = "U" Then
                .ActiveWindow.Selection.ShapeRange.Top = 35
                .ActiveWindow.Selection.ShapeRange.Left = 75
                .ActiveWindow.Selection.ShapeRange.Height = 36
                If iIndex = 6 Then
                    .ActiveWindow.Selection.ShapeRange.Top = 20
                    .ActiveWindow.Selection.ShapeRange.Left = 75
                    .ActiveWindow.Selection.ShapeRange.Height = 56
                ElseIf iIndex = 11 Or iIndex = 15 Then
                    .ActiveWindow.Selection.ShapeRange.Top = 20
                    .ActiveWindow.Selection.ShapeRange.Left = 75
                    .ActiveWindow.Selection.ShapeRange.Height = 56
                    .ActiveWindow.Selection.ShapeRange.LockAspectRatio = False
                    .ActiveWindow.Selection.ShapeRange.Width = 450
                End If
            Else
                .ActiveWindow.Selection.ShapeRange.Left = 37
                .ActiveWindow.Selection.ShapeRange.Height = 36
            End If
            .ActiveWindow.Selection.TextRange.ParagraphFormat.Alignment = 1 '1 - left, 2 - centre
            .ActiveWindow.Selection.ShapeRange.ScaleWidth 0.99, msoFalse, msoScaleFromTopLeft
            If a = "U" And iIndex = 6 Then
                .ActiveWindow.Selection.ShapeRange.ScaleWidth 0.79, msoFalse, msoScaleFromTopLeft
            End If
            .ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Characters(Start:=1, Length:=0).Select

        With .ActiveWindow.Selection.TextRange
            If iIndex = 1 Then
                .Text = "I"
            ElseIf iIndex = 2 Then
                .Text = "D"
            ElseIf iIndex = 3 Then
                .Text = "C"
            ElseIf iIndex = 4 Then
                .Text = "A"
            ElseIf iIndex = 5 Then
                .Text = "Is"
            ElseIf iIndex = 6 Then
                .Text = "Co"
            ElseIf iIndex = 7 Then
                .Text = "S"
            ElseIf iIndex = 8 Then
                .Text = "De"
            ElseIf iIndex = 9 Then
                .Text = "M"
            ElseIf iIndex = 10 Then
                .Text = "Ev"
            ElseIf iIndex = 11 Then
                .Text = "Em"
            ElseIf iIndex = 12 Then
                .Text = "Da"
            ElseIf iIndex = 13 Then
                .Text = "Ch"
            ElseIf iIndex = 14 Then
                .Text = "Ad"
            ElseIf iIndex = 15 Then
                .Text = "Co"
            ElseIf iIndex = 16 Then
                .Text = "nl"
            End If

            With .Font
                .Name = "Arial"
                .NameOther = "Arial"
                .Size = 20
                .Bold = msoTrue
                .Italic = msoFalse
                .Underline = msoFalse
                .Shadow = msoFalse
                .Emboss = msoFalse
                .BaselineOffset = 0
                .AutorotateNumbers = msoFalse
                '.Color.SchemeColor = ppTitle
            End With
        End With
       If iIndex = 6 Then
           wks.ChartObjects(1).CopyPicture xlScreen, xlBitmap

           .ActiveWindow.View.gotoslide (iIndex + 2)
           .ActiveWindow.View.Paste
    Application.CutCopyMode = False
           If a = "U" Then
               .ActiveWindow.Selection.ShapeRange.Left = 40
               .ActiveWindow.Selection.ShapeRange.Top = 95
           ElseIf a = "O" Then
               .ActiveWindow.Selection.ShapeRange.Top = 88
               .ActiveWindow.Selection.ShapeRange.Left = 35
           Else
               .ActiveWindow.Selection.ShapeRange.Top = 75
               .ActiveWindow.Selection.ShapeRange.Left = 17
           End If
       Else
            wks.UsedRange.CopyPicture xlScreen, xlBitmap

            If iIndex = 1 Then
                .ActiveWindow.View.gotoslide (1)
            ElseIf iIndex = 2 Then
                .ActiveWindow.View.gotoslide (3)
            Else
                .ActiveWindow.View.gotoslide (iIndex + 2)
            End If
            .ActiveWindow.View.Paste
      Application.CutCopyMode = False
            If iIndex = 1 Then
                .ActiveWindow.Selection.ShapeRange.Top = 170
                If a = "U" Then
                    .ActiveWindow.Selection.ShapeRange.Top = 210
                    .ActiveWindow.Selection.ShapeRange.Left = 210
                End If
            ElseIf iIndex = 2 Then
                .ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True
                .ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
                .ActiveWindow.Selection.ShapeRange.Top = 60
                If a = "U" Then
                    .ActiveWindow.Selection.ShapeRange.Top = 85
                    .ActiveWindow.Selection.ShapeRange.Left = 60
                ElseIf a = "O" Then
                    .ActiveWindow.Selection.ShapeRange.Top = 87
                    .ActiveWindow.Selection.ShapeRange.Left = 35
                ElseIf a = "O" Then
                    .ActiveWindow.Selection.ShapeRange.Top = 75
                End If
            ElseIf iIndex = 3 Then
                .ActiveWindow.Selection.ShapeRange.Height = 410
                .ActiveWindow.Selection.ShapeRange.Left = 35
                .ActiveWindow.Selection.ShapeRange.LockAspectRatio = False
                If a = "U" Then
                    .ActiveWindow.Selection.ShapeRange.Top = 65
                    .ActiveWindow.Selection.ShapeRange.Width = 645
                ElseIf a = "O" Then
                    .ActiveWindow.Selection.ShapeRange.Top = 88
                    .ActiveWindow.Selection.ShapeRange.Height = 400
                    .ActiveWindow.Selection.ShapeRange.Width = 650
                ElseIf a = "U" Then
                    .ActiveWindow.Selection.ShapeRange.Left = 60
                    .ActiveWindow.Selection.ShapeRange.Top = 95
                    .ActiveWindow.Selection.ShapeRange.Height = 405
                Else
                    .ActiveWindow.Selection.ShapeRange.Width = 645
                End If
            ElseIf iIndex = 4 Then
                If a = "U" Then
                    .ActiveWindow.Selection.ShapeRange.Left = 60
                    .ActiveWindow.Selection.ShapeRange.Top = 95
                ElseIf a = "O" Then
                    .ActiveWindow.Selection.ShapeRange.Top = 88
                    .ActiveWindow.Selection.ShapeRange.Left = 35
                Else
                    .ActiveWindow.Selection.ShapeRange.Top = 75
                    .ActiveWindow.Selection.ShapeRange.Left = 37
                End If
            ElseIf iIndex = 5 Or iIndex = 8 Then
                .ActiveWindow.Selection.ShapeRange.Height = 400
                .ActiveWindow.Selection.ShapeRange.LockAspectRatio = False
                .ActiveWindow.Selection.ShapeRange.Width = 645
                If a = "U" Then
                    .ActiveWindow.Selection.ShapeRange.Left = 60
                    .ActiveWindow.Selection.ShapeRange.Top = 95
                    .ActiveWindow.Selection.ShapeRange.Width = 640
                ElseIf a = "O" Then
                    .ActiveWindow.Selection.ShapeRange.Top = 88
                    .ActiveWindow.Selection.ShapeRange.Left = 35
                Else
                    .ActiveWindow.Selection.ShapeRange.Top = 75
                    .ActiveWindow.Selection.ShapeRange.Left = 37
                End If
            ElseIf iIndex = 7 Then
                .ActiveWindow.Selection.ShapeRange.Width = 645
                If a = "U" Then
                    .ActiveWindow.Selection.ShapeRange.Left = 60
                    .ActiveWindow.Selection.ShapeRange.Top = 105
                    .ActiveWindow.Selection.ShapeRange.Width = 640
                ElseIf a = "O" Then
                    .ActiveWindow.Selection.ShapeRange.Top = 100
                    .ActiveWindow.Selection.ShapeRange.Left = 35
                Else
                    .ActiveWindow.Selection.ShapeRange.Top = 85
                    .ActiveWindow.Selection.ShapeRange.Left = 37
                End If
            ElseIf iIndex = 17 Or iIndex = 12 Then
                .ActiveWindow.Selection.ShapeRange.Height = 390
                .ActiveWindow.Selection.ShapeRange.LockAspectRatio = False
                .ActiveWindow.Selection.ShapeRange.Width = 645
                If a = "U" Then
                    .ActiveWindow.Selection.ShapeRange.Left = 60
                    .ActiveWindow.Selection.ShapeRange.Top = 95
                    .ActiveWindow.Selection.ShapeRange.Width = 640
                ElseIf a = "O" Then
                    .ActiveWindow.Selection.ShapeRange.Top = 88
                    .ActiveWindow.Selection.ShapeRange.Left = 35
                Else
                    .ActiveWindow.Selection.ShapeRange.Top = 75
                    .ActiveWindow.Selection.ShapeRange.Left = 37
                End If
            ElseIf iIndex = 10 Then
                If a = "U" Then
                    .ActiveWindow.Selection.ShapeRange.Left = 60
                    .ActiveWindow.Selection.ShapeRange.Top = 95
                ElseIf a = "O" Then
                    .ActiveWindow.Selection.ShapeRange.Top = 95
                    .ActiveWindow.Selection.ShapeRange.Left = 35
                Else
                    .ActiveWindow.Selection.ShapeRange.Top = 75
                    .ActiveWindow.Selection.ShapeRange.Left = 37
                End If
            ElseIf iIndex = 9 Or iIndex = 13 Or iIndex = 11 Then
                If a = "U" Then
                    .ActiveWindow.Selection.ShapeRange.Left = 60
                    .ActiveWindow.Selection.ShapeRange.Top = 95
                ElseIf a = "O" Then
                    .ActiveWindow.Selection.ShapeRange.Top = 88
                    .ActiveWindow.Selection.ShapeRange.Left = 35
                Else
                    .ActiveWindow.Selection.ShapeRange.Top = 75
                    .ActiveWindow.Selection.ShapeRange.Left = 37
                End If
            ElseIf iIndex = 14 Or iIndex = 15 Or iIndex = 16 Or iIndex = 18 Then
                If a = "U" Then
                    .ActiveWindow.Selection.ShapeRange.Left = 60
                    .ActiveWindow.Selection.ShapeRange.Top = 105
                ElseIf a = "O" Then
                    .ActiveWindow.Selection.ShapeRange.Top = 100
                    .ActiveWindow.Selection.ShapeRange.Left = 35
                Else
                    .ActiveWindow.Selection.ShapeRange.Top = 85
                    .ActiveWindow.Selection.ShapeRange.Left = 37
                End If
            End If
        End If
        Next
        .Visible = True
       .ActiveWindow.View.gotoslide (21)
       .ActiveWindow.Selection.SlideRange.Delete
       .ActiveWindow.View.gotoslide (21)
       .ActiveWindow.Selection.SlideRange.Delete
      
       .ActiveWindow.View.gotoslide (2)
       If a = "O" Then
           .ActiveWindow.Selection.SlideRange.Shapes(2).Select
           .ActiveWindow.Selection.ShapeRange.IncrementLeft -18#
           .ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Select
           .ActiveWindow.Selection.ShapeRange.Top = 13
           .ActiveWindow.Selection.ShapeRange.Left = 35
           .ActiveWindow.Selection.ShapeRange.Height = 53
       ElseIf a = "U" Then
           .ActiveWindow.Selection.SlideRange.Shapes(3).Select
           .ActiveWindow.Selection.ShapeRange.IncrementLeft -18#
           .ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Select
           .ActiveWindow.Selection.ShapeRange.Top = 25
           .ActiveWindow.Selection.ShapeRange.Left = 70
           .ActiveWindow.Selection.ShapeRange.Height = 50
           .ActiveWindow.Selection.ShapeRange.LockAspectRatio = False
           .ActiveWindow.Selection.ShapeRange.Width = 475
       Else
           .ActiveWindow.Selection.SlideRange.Shapes(3).Select
           .ActiveWindow.Selection.ShapeRange.IncrementLeft -18#
           .ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Select
           .ActiveWindow.Selection.ShapeRange.Left = 37
           .ActiveWindow.Selection.ShapeRange.Height = 53

       End If
       .ActiveWindow.Selection.TextRange.ParagraphFormat.Alignment = 1 '1 - left, 2 - centre
       .ActiveWindow.Selection.ShapeRange.ScaleWidth 0.99, msoFalse, msoScaleFromTopLeft
       .ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Characters(Start:=1, Length:=0).Select

       With .ActiveWindow.Selection.TextRange
           .Text = b
            With .Font
                .Name = "Arial"
                .NameOther = "Arial"
                .Size = 14
                .Bold = msoTrue
                .Italic = msoFalse
                .Underline = msoFalse
                .Shadow = msoFalse
                .Emboss = msoFalse
                .BaselineOffset = 0
                .AutorotateNumbers = msoFalse
                '.Color.SchemeColor = ppTitle
            End With

       End With
       .ActiveWindow.View.gotoslide (1)
       Sheets("Account Name").Select
       ActiveSheet.Range("A2").Select
    End With
   
    Length = Len(cellName)
    Length = Length - 10
    fileName = Mid(cellName, 10, Length)
    pathName = "My Local Drive path"
    saveLoc = pathName + loopName + "_" + fileName
    pptApp.ActivePresentation.SaveAs saveLoc
    pptApp.ActivePresentation.Saved = True
    pptApp.ActivePresentation.Close
    pptApp.Quit
   
End Sub

Answer 6

Just thinking, maybey this has something to do with excel or powerpoint keeping an "Undo"-list. I once had a similar problem: your application may be keeping track of a list of actions  you did and this is running out of memory. When you would do this manually, you have to opportunity to "undo" your action, maybey excel or powerpoint is allowing the same feature when your code is running, but at a certain point, it's giving up on you. this could cause the error.

On the other hand, when I'm using powerpoint and excel, I try to link the charts in powerpoint and update them, instead of puching the charts to powerpoint. (I'm just saying, maybey this is not possible in your case)