我有一个VBA代码，用于将范围复制为图片并将其粘贴到图表中。它这样做，所以我可以将它保存到图片中。这段代码有70％的成功率，当它不起作用时，它会发出错误＆＃34;范围类的CopyPicture方法失败＆＃34;。我不明白为什么它有时可以工作，有时候并没有给出相同的输入。
有人可以帮忙吗？
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
答案 0 :(得分：1)
通常人们倾向于在任何地方添加application.screenupdating=false作为一种习惯（而且它通常都很好）。
但在这种情况下，Excel无法查看范围（正确），因此无法复制它。 我想它内部确实有效，但由于编码不好或滞后，它每次都不起作用。
所以，我检查过，如果你在application.screenupdating=false之前删除copypicture，它就可以了，（即使没有也不比清除剪贴板/ Rg.copy / appearence = xlPrinter / solutions更好）。 / p>
这是我使用的代码示例（过度保护再次使用坏副本）：
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
您可以跳过您不需要的部分（这个是控件，当按钮右侧，将范围复制到用户表单上的标签图片中。
编辑：我找到了一种方法来强制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
答案 1 :(得分：0)
对我来说，我有类似的问题，我可以通过在xlScreen
xlPrinter和selectRange.CopyPicture之间进行更改来解决问题
我希望这会有所帮助
答案 2 :(得分：0)
我正在努力解决与你相同的问题，我认为这与我们的VBA代码或缺乏编程技巧无关。这个错误太随意了。
此外，如果在收到错误消息后我点击DEBUG并按 F8 继续逐步执行代码，那么我就可以跳过错误。在有问题的行后，我按 F5 继续正常执行模式。
当然，以上不是解决方案，但我的编码没有任何问题。
嗯，我这样做了，它对我有用：
在这句话之前，
rgToPic.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
我添加了这个：
rgToPic.Copy 'just for nothing
我再也没有在CopyPicture方法中遇到错误。
在其他地方寻找此问题我发现有些用户可以通过在CopyPicture方法之前引入这句话来跳过错误：
application.CutCopyMode=false
答案 3 :(得分：0)
虽然这是一篇很老的帖子，但这可能对某些人有帮助。
很长一段时间我一直在努力解决类似的问题。 CopyPicture失败了
（在某些计算机上比其他计算机更频繁，但在我的笔记本电脑上难以复制）当我复制范围时
包含嵌入的PNG图片。它只在Application.Visible=0模式下失败，Application.Visible=1工作正常（对于我的应用程序，必须以隐身模式运行Excel）。最后，我发现在具有1个CPU的VM上运行时，我可以100％重现该问题。以下解决方案很奇怪，但似乎完全解决了我的问题。
嵌入式PNG是Excel API术语中的Shape。在调用CopyPicture：
# 'rng' is a range that I want CopyPicture on
for shape in rng.Shapes: pass
rng.CopyPicture(xlScreen, xlBitmap)
我的发现与this solution有些相似，
CopyPicture在图表范围内失败的地方。在他们的情况下，
激活工作簿和范围本身有帮助。
假设，似乎有理由认为在缓慢或负载很重的计算机上，Excel会进行懒惰处理＆＃34;页面上的复杂对象，即在以某种方式访问对象之前不渲染它们。强制渲染的一种方法似乎是在Visible=1模式下运行。另一种方法是循环遍历对象。如果是这种情况，那么这是Excel CopyPicture实现的一个错误，它在尝试复制之前不会强制复制对象进行渲染。当复制方法发现目标范围的渲染未准备好时，它只会抛出错误而不是强制渲染范围。好吧，至少这是我的理论。
答案 4 :(得分：0)
对我唯一有效的方法是在CopyPicture方法之前添加一个延迟。我们在输入时将其调整得更短，但我知道50毫秒的延迟可以正常工作：
声明PtrSafe子睡眠库“ kernel32”（ByVal dw毫秒），
'设置要捕获的范围
将rgExp设为范围：设置rgExp = Range（“ B2：D6”）
睡眠（50）'暂停以毫秒为单位，以防止CopyPicture出现运行时错误，您的系统可能可以使用更短的睡眠，或者可能需要更长的时间...
'将范围复制为图片到剪贴板
rgExp.CopyPicture外观：= xlScreen，格式：= xlBitmap
答案 5 :(得分：0)
CopyPicture方法将结果发送到剪贴板。但是由于安全原因，Win10会在屏幕锁定时禁止访问剪贴板。因此，如果在锁定屏幕时运行宏，则CopyPicture方法将失败，错误代码为1004。
Worksheet.Pictures.Paste也会发生相同的错误。
另一方面，简单的Copy和PasteSpecial不会弹出错误。当剪贴板不可访问时，内容不会复制到剪贴板，但VBA不会抱怨。
很遗憾，PasteSpecial不能选择粘贴为图片。
唯一简单的解决方法是在运行宏时使计算机保持解锁状态。
答案 6 :(得分：0)
为此，我的解决方法是将其放入while循环中捕获错误并继续重试，直到它能够完全复制范围而没有错误消息为止。现在就像魅力一样。
答案 7 :(得分：0)
对我有用的是在我用 Application.CutCopyMode = False 复制图片之前清除剪贴板
我想象的最佳做法是粘贴您需要的内容，然后直接清除剪贴板。
答案 8 :(得分：-2)
我找到了一个简单的方法来解决这个问题，而我几个月来一直在苦苦挣扎。我知道这是一个“错误代码”，但对我来说非常有效。在我的情况下，详细信息已被复制，但调试错误窗口正在填充。因此，我只是跳过了调试窗口，我的生活变得更加轻松。
修正只是在VBA中“复制”代码之前添加以下代码。这肯定会解决此错误。
On Error Resume Next