CopyPicture method of range class failed - sometim

问题:

I have a VBA code which I am using to copy ranges as a picture and paste them into a chart. It does this so I can save it into a picture. This code has like a 70% success rate, and when it doesn't work, it gives out the error "CopyPicture method of range class failed". I don't understand why it can sometimes work and sometimes doesn't given that it is taking the same inputs.

Can anyone help?

Public Sub ExportRange(workbookPath As String, sheetName As String, rangeString As String, savepath As String)

    Set tempWorkBook = Workbooks.Open(workbookPath)

    Dim selectRange As range
    Set selectRange = Worksheets(sheetName).range(rangeString)
    Dim numRows As Long
    numRows = selectRange.Rows.Count
    Dim numCols As Long
    numCols = selectRange.Columns.Count

    ' Transfer selection to a new sheet and autofit the columns
    selectRange.Copy
    Dim tempSheet As Worksheet
    Set tempSheet = Sheets.Add
    tempSheet.range("A1").PasteSpecial xlPasteAll

    ActiveSheet.UsedRange.Columns.AutoFit
    Set selectRange = ActiveSheet.UsedRange
    selectRange.Select
    selectRange.CopyPicture xlScreen, xlPicture

    Dim tempSheet2 As Worksheet
    Set tempSheet2 = Sheets.Add
    Dim oChtobj As Excel.ChartObject
    Set oChtobj = tempSheet2.ChartObjects.Add( _
        selectRange.Left, selectRange.Top, selectRange.Width, selectRange.Height)

    Dim oCht As Excel.Chart
    Set oCht = oChtobj.Chart
    oCht.Paste
    oCht.Export filename:=savepath
    oChtobj.Delete

    Application.DisplayAlerts = False
    tempSheet.Delete
    tempSheet2.Delete
    tempWorkBook.Close
    Application.DisplayAlerts = True

End Sub

回答1:

Usually people tend to add application.screenupdating=falseeverywhere, as a habit (and it's usually good).

But in this case, Excel can't see the Range (properly) and thus can't copy it. I guess it internaly does something for it to work but because of bad coding or lag whatsoever, it doesn't work every time.

So , i checked that if you remove application.screenupdating=false just before the copypicture, it works, (even without and better than the clear clipboard / Rg.copy / appearence=xlPrinter/ solutions).

here is an exemple of code i use (with over-protection agains bad copies) :

If Button = 2 And Eventz Then
  Eventz = False
  Cache_Souris
  XX = X: YY = Y
  sound "scroll1_short.wav"
  Dim iPic2 As Object, Samerde As Boolean
  With Lbl_CadreGothique.Parent
        'With .Controls.add("Forms.Image.1", "Temp", False)
        With .Controls("Temp")
              .Top = Lbl_CadreGothique.Top + Y - 20 ': .Left = Lbl_CadreGothique.Left + X + 20
              .BorderColor = 0: .BackColor = Lbl_TypeSkillTxt.ForeColor
              .PictureAlignment = fmPictureAlignmentTopLeft
              Err.Clear: On Error Resume Next
              .AutoSize = True
              Clear_Clipboard
              'Rg.Copy
              Rg.CopyPicture xlScreen, xlPicture 'xlBitmap
              If Err = 0 Then
                    Set iPic2 = PastePicture '(xlBitmap)
                    If Not iPic2 Is Nothing Then
                          .Picture = iPic2
                    Else
                          Rg.CopyPicture xlScreen, xlBitmap:
                          Set iPic2 = PastePicture(xlBitmap)
                          If Not iPic2 Is Nothing Then
                                .Picture = iPic2
                          Else: Rg.CopyPicture xlPrinter, xlBitmap: .Picture = PastePicture(xlBitmap)
                          End If
                    End If
                    Set iPic2 = Nothing
              Else
                    Rg.CopyPicture xlScreen, xlBitmap: .Picture = PastePicture(xlBitmap)
              End If
              Err.Clear: On Error GoTo 0
              .AutoSize = False

              If .Width > Rg.Width Then .Width = Rg.Width: Samerde = True

              If Lbl_CadreGothique.Left + Lbl_CadreGothique.Width + X + 100 < .Parent.InsideWidth Then
                    .Left = Lbl_CadreGothique.Left + X + 20
              Else: .Left = Lbl_CadreGothique.Left + X - 10 - .Width
              End If


              If .Height > Rg.Height Then .Height = Rg.Height: Samerde = True
               'si marche pas mettre picture ?
              If Samerde Then
                    .PictureSizeMode = fmPictureSizeModeStretch
              Else: .PictureSizeMode = fmPictureSizeModeClip
              End If
              .Top = Min2(.Top, .Parent.InsideHeight - .Height)
              .ZOrder 0
              Application.ScreenUpdating = False
              .Visible = True
              DoEvents
              'Debug.Print Rg.Width, .Width
        End With
  End With
  aff_souris
  Calc_ON
  Eventz = True
End If

You can skip the parts you don't need (this one is a control, when button right, copies range into a label's picture on a userform.

EDIT : i have found a way to force excel to wait until the clipboard has a picture in it, because sometimes it's too fast:

Private Declare PtrSafe Function IsClipboardFormatAvailable Lib "user32" (ByVal wFormat As Long) As Long
Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 

'just after copypicture, add this: (in my case i added it inside pastepicture, or i'd have too much coding )
Dim T#
  Do
      Waiting (2)
Loop Until IsClipboardFormatAvailable(2) Or Timer - T > 0.3

Sub Waiting(ByVal Mili_Seconds&)
Sleep Mili_Seconds
End Sub

回答2:

For me I had similar problem and I could solve it by changing between xlScreen and xlPrinter in selectRange.CopyPicture

I hope this helps

回答3:

I was struggling with the very same issue than you and I think is nothing to do with our VBA code or lack of programming skills. The error it's too random.

Moreover, if after getting the error message I clicked DEBUG and pressed F8 to continue executing the code step by step, then I was able to skip the error. After the problematic line I pressed F5 to continue in normal execute mode.

Of course, the above is not a solution but reveals nothing wrong with my coding.

Well, I did this and it worked for me:

before this sentence,

rgToPic.CopyPicture Appearance:=xlScreen, Format:=xlBitmap

I added this one:

rgToPic.Copy  'just for nothing

and I never have had the error in CopyPicture method again.

---

Looking for this issue in other places I found out some users were able to skip the error by introducing this sentence before the CopyPicture method:

    application.CutCopyMode=false

回答4:

Although this is an old post, maybe this will help someone. I was struggling with similar problem for a long time. CopyPicture failed (on some computers more often than others, but hard to replicate on my laptop) when I was copying the range that contained an embedded PNG picture. It only failed in Application.Visible=0 mode, Application.Visible=1 worked fine (for my application it is mandatory to run Excel in invisible mode). Finally I found that I can reproduce the problem 100% of the times when run on a VM with 1 CPU. The following solution is weird, but seems to be solving my problem completely.

Embedded PNG is a Shape in Excel API terms. I just needed to cycle through the shapes (not even doing anything) before calling CopyPicture:

# 'rng' is a range that I want CopyPicture on 
for shape in rng.Shapes: pass
rng.CopyPicture(xlScreen, xlBitmap)

My finding is somewhat similar to this solution, where CopyPicture was failing on a range with charts. In their case, activating workbook and range itself helped.

Hypothesizing, it seems plausible that on a slow or heavily loaded computer Excel does "lazy processing" of the complex objects on a page, i.e. not rendering them until object is accessed in some way. One way to force rendering seems to run in Visible=1 mode. Another way is to cycle through the objects. If this is the case, then it is a bug of Excel's CopyPicture implementation where it doesn't force complex objects to render before trying to copy. When copy method finds out rendering for the target range is not ready, it simply throws an error instead of forcing the range to render. Well, at least that's my theory.

回答5:

The only thing that worked for me was to add a delay BEFORE the CopyPicture method. We are tweaking it shorter as I type this, but I know a 50 ms delay was working fine:

Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

'Set Range you want to capture

Dim rgExp As Range: Set rgExp = Range("B2:D6")

Sleep (50) ' Pause in milliseconds to prevent runtime error on CopyPicture, your system may be able to use shorter sleep, or may need longer...

' Copy range as picture onto Clipboard

rgExp.CopyPicture Appearance:=xlScreen, Format:=xlBitmap

回答6:

I found a easy way to fix this issue with which I was struggling for a few months. I know this is a "BAD CODE" but it helped and worked perfect for me. In my case details were getting copied but the debug error window was populating. Hence I just skipped the debug window and my life became easier.

Fix is just add below code in front of the "copy" code in your VBA. This will sure fix this error.

On Error Resume Next