none
Random error with copying Excel to Powerpoint RRS feed

  • 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!

    -
    • Moved by Jeff Shan Monday, January 18, 2010 9:39 AM for better support (From:Visual Basic General)
    Friday, January 15, 2010 10:24 AM

All replies

  • 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
    Friday, January 15, 2010 11:32 AM
  • 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
    Monday, January 18, 2010 11:26 AM
  • 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...
    -
    Monday, January 18, 2010 11:27 AM
  • 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.
    Friday, January 22, 2010 8:04 AM
  • 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


    • Edited by anil1121 Friday, August 15, 2014 5:30 PM
    Thursday, August 14, 2014 5:34 PM
  • 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)

    • Proposed as answer by Wouter Defour Monday, August 25, 2014 2:05 PM
    Wednesday, August 20, 2014 9:49 AM