vba 范围类的 CopyPicture 方法失败 - 有时

CopyPicture method of range class failed - sometimes

提问by user3759627

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.

我有一个 VBA 代码，我用它来将范围复制为图片并将它们粘贴到图表中。它这样做，所以我可以将它保存到图片中。这段代码有 70% 的成功率，当它不起作用时，它会给出错误“范围类的 CopyPicture 方法失败”。我不明白为什么它有时可以工作，有时却没有考虑到它采用相同的输入。

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

回答by Patrick Lepelletier

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

通常人们倾向于在application.screenupdating=false任何地方添加，作为一种习惯（这通常是好的）。

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.

但在这种情况下，Excel 无法（正确）看到范围，因此无法复制它。我想它在内部做了一些工作来让它工作，但由于糟糕的编码或任何滞后，它并不是每次都有效。

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

所以，我检查了如果你application.screenupdating=false在 之前删除copypicture，它可以工作（即使没有并且比清晰的剪贴板/ Rg.copy/appearence=xlPrinter/解决方案更好）。

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:

编辑：我找到了一种方法来强制 excel 等待剪贴板中有图片，因为有时它太快了：

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

回答by Brett G

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:

唯一对我有用的是在 CopyPicture 方法之前添加延迟。我们在输入时将其调整得更短，但我知道 50 毫秒的延迟工作正常：

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

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

'设置要捕获的范围

Dim rgExp As Range：设置 rgExp = Range("B2:D6")

Sleep (50) ' 以毫秒为单位暂停以防止 CopyPicture 上的运行时错误，您的系统可能能够使用更短的睡眠，或者可能需要更长的...

' 将范围作为图片复制到剪贴板

rgExp.CopyPicture 外观：=xlScreen，格式：=xlBitmap

回答by user7092184

The CopyPicturemethod sends the result to clipboard. But due to security reason, Win10 forbids access to clipboard while screen is locked. Therefore if you run the macro while locking screen, the CopyPicturemethod will fail with error code 1004.
The same error happens with Worksheet.Pictures.Paste.

该CopyPicture方法将结果发送到剪贴板。但出于安全原因，Win10 禁止在屏幕锁定时访问剪贴板。因此，如果您在锁定屏幕时运行宏，该CopyPicture方法将失败并显示错误代码 1004。
同样的错误发生在Worksheet.Pictures.Paste.

On the other hand, simple Copyand PasteSpecialwon't pop error. When the clipboard is not accessible, the content won't be copied to clipboard but VBA won't complain about it.

另一方面，简单Copy且PasteSpecial不会弹出错误。当剪贴板不可访问时，内容不会被复制到剪贴板，但 VBA 不会抱怨它。

Unfortunately, PasteSpecialdoesn't have the option to paste as picture.
The only simple workaround is leaving your computer unlocked while running the macro.

不幸的是，PasteSpecial没有粘贴为图片的选项。
唯一简单的解决方法是在运行宏时让计算机处于解锁状态。

回答by Austin

My work around for this was to throw it in an error catching while loop and keep retrying it until it was able to fully copy the range without an error message. Works like a charm now.

我对此的解决方法是将其放入错误捕获 while 循环中并不断重试，直到它能够完全复制范围而没有错误消息。现在就像一个魅力。

回答by IdontCareAboutReputationPoints

For me I had similar problem and I could solve it by changing between xlScreenand xlPrinterin selectRange.CopyPicture

对我来说，我有类似的问题，我可以通过改变之间解决它xlScreen，并xlPrinter在selectRange.CopyPicture

I hope this helps

我希望这有帮助

回答by Chema Vascuence

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.

我正在为与您完全相同的问题而苦苦挣扎，我认为这与我们的 VBA 代码或缺乏编程技能无关。错误太随机了。

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

此外，如果在收到错误消息后单击 DEBUG 并按F8继续逐步执行代码，那么我可以跳过错误。在出现问题的行之后，我按下F5以继续正常执行模式。

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 CopyPicturemethod again.

我再也没有在CopyPicture方法上犯过错误。

---

---

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

在其他地方找这个问题发现有些用户可以通过在CopyPicture方法之前引入这句话来跳过错误：

    application.CutCopyMode=false

回答by glexey

Although this is an old post, maybe this will help someone. I was struggling with similar problem for a long time. CopyPicturefailed (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=0mode, Application.Visible=1worked 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.

虽然这是一个旧帖子，但也许这会对某人有所帮助。我在类似的问题上挣扎了很长时间。CopyPicture当我复制包含嵌入的 PNG 图片的范围时，失败（在某些计算机上比其他计算机更频繁，但很难在我的笔记本电脑上复制）。它仅在Application.Visible=0模式下失败，Application.Visible=1工作正常（对于我的应用程序，必须在不可见模式下运行 Excel）。最后，我发现在具有 1 个 CPU 的 VM 上运行时，我可以 100% 地重现该问题。以下解决方案很奇怪，但似乎完全解决了我的问题。

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

嵌入式 PNG 是ShapeExcel API 术语。我只需要在调用之前循环遍历形状（甚至不做任何事情）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 CopyPicturewas failing on a range with charts. In their case, activating workbook and range itself helped.

我的发现有点类似于这个解决方案，在CopyPicture图表范围内失败。在他们的情况下，激活工作簿和范围本身有帮助。

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=1mode. Another way is to cycle through the objects. If this is the case, then it is a bug of Excel's CopyPictureimplementation 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.

假设，在缓慢或重载的计算机上，Excel 对页面上的复杂对象进行“惰性处理”，即在以某种方式访问​​对象之前不渲染它们，这似乎是合理的。强制渲染的一种方法似乎在Visible=1模式下运行。另一种方法是循环遍历对象。如果是这种情况，那么这是 ExcelCopyPicture实现的一个错误，它不会在尝试复制之前强制呈现复杂对象。当 copy 方法发现目标范围的渲染未准备好时，它只会抛出错误而不是强制渲染范围。好吧，至少这是我的理论。

回答by Vijay V V

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.

修复只是在 VBA 中的“复制”代码前面添加以下代码。这肯定会修复这个错误。

On Error Resume Next