范围类的CopyPicture方法失败 – 有时
我有一个VBA代码，我正在使用复制范围作为图片，并将其粘贴到图表中。 它这样做，所以我可以把它保存成图片。 这个代码有70％的成功率，当它不起作用时，它会发出错误“范围类的CopyPicture方法失败”。 我不明白为什么有时可以工作，有时候并没有给出相同的意见。
谁能帮忙？
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 对我来说，我有类似的问题，我可以通过更改xlScreen和xlPrinter在selectRange.CopyPicture
我希望这有帮助
我一直在为与你同样的问题而苦苦挣扎，我认为这与我们的VBA代码或缺乏编程技能无关。 这个错误太随机了。
此外，如果得到错误信息后，我点击DEBUG，然后按下F8继续执行代码，然后我可以跳过错误。 有问题的线后，我按F5继续在正常执行模式。
当然，上述不是一个解决scheme，但我的编码没有任何错误。
那么，我做到了这一点，它为我工作：
在这句话之前，
rgToPic.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
我加了这个：
rgToPic.Copy 'just for nothing
我再也没有在CopyPicture方法中的错误。
在其他地方寻找这个问题，我发现一些用户可以通过在CopyPicture方法之前引入这个句子来跳过错误：
application.CutCopyMode=false
虽然这是一个旧post，也许这会帮助别人。 我在很长一段时间里也遇到类似的问题。 当我复制包含embeddedPNG图片的范围时， CopyPicture失败（在某些计算机上比其他计算机更频繁，但难以在笔记本电脑上复制）。 它只在Application.Visible=0模式失败， Application.Visible=1工作正常（对于我的应用程序，它是强制运行在不可见模式下的Excel）。 最后我发现在1个CPU的虚拟机上运行时，可以100％的重现问题。 下面的解决scheme很奇怪，但似乎完全解决了我的问题。
embedded式PNG是Excel API中的Shapeforms。 我只需要在调用CopyPicture之前CopyPicture形状（甚至不做任何事情）：
# 'rng' is a range that I want CopyPicture on for shape in rng.Shapes: pass rng.CopyPicture(xlScreen, xlBitmap)
我的发现有点类似于这个解决scheme ，其中CopyPicture在图表范围上失败。 在他们的情况下，激活工作簿和范围本身帮助。
假设，似乎有理由认为，在缓慢或重载的计算机上，Excel对页面上的复杂对象进行“延迟处理”，也就是说，在对象以某种方式访问之前，不会渲染它们。 一种强制渲染的方法似乎运行在Visible=1模式下。 另一种方法是循环通过对象。 如果是这种情况，那么这是Excel的CopyPicture实现的错误，它不会强制复制对象在尝试复制之前进行渲染。 当复制方法发现渲染目标范围没有准备好时，它只是抛出一个错误，而不是强制范围渲染。 那么，至less这是我的理论。
通常人们往往会添加application.screenupdating=false ，作为一种习惯（通常很好）。
但在这种情况下，Excel无法看到范围（正确），因此无法复制它。 我认为它内在做一些工作，但由于错误的编码或滞后，它不是每次都工作。
所以，我查了一下，如果你在copypicture之前删除了application.screenupdating=false ，它可以工作，（甚至没有，比清除剪贴板/ Rg.copy / appearence = xlPrinter /解决scheme更好）。
这里是我使用的代码（与过度保护再次坏副本）的例子：
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
你可以跳过你不需要的部分（这个是一个控件，当右边的button将范围复制到用户窗体上的标签图片上时。