Excel 2010 VBA:运行时错误1004,Microsoft Excel不能粘贴数据

我一直在运行一个剪切和粘贴图片例程一段时间,所有突然的Excel开始给我这个运行时错误。 到目前为止,它一直工作正常(没有操作系统更新或重新启动,尽pipe我尝试closures并重新打开Excel以查看是否有帮助)。 更奇怪的是,脚本做了一个批量复制和paste.picture,同样的范围(重新计算的值)被复制和粘贴13次,错误信息通常popup在最后一个循环或偶尔在某个随机点。

我查了一下support.microsoft.com/en-us/kb/905164:“如果满足下列任一条件,可能会发生此问题:

The Microsoft Visual Basic for Applications (VBA) macro copies and pastes one whole row in an Excel 2003 workbook. The Microsoft VBA macro copies and pastes a range of 2,516 rows or more rows in an Excel 2003 workbook." 

不过,我正在复制一个12,12的单元格,从A1到L12确切地说,甚至不是接近整行。 我曾尝试使用range.offset,xldown,rannge(单元格(1,1),单元格(12,12)),但没有一个帮助。

有没有人遇到类似的东西?

 Sub PutPic(ByRef FN As String) Dim fname As String fname = "E:\Users\ABCD\Documents\EFGH\" & FN Worksheets(2).Range(Cells(1, 1), Cells(12, 12)).Select 'Sheets("sheet2").Range("A1:l12").Select Selection.Copy 'Sheets("sheet2").Range("a1").Select ActiveSheet.Pictures.Paste(Link:=False).Select Selection.Name = "Pic" Selection.ShapeRange.ScaleWidth 2, msoFalse, msoScaleFromTopLeft Selection.ShapeRange.ScaleHeight 2, msoFalse, msoScaleFromMiddle Dim ChtObj As ChartObject With ThisWorkbook.Worksheets(2) .Activate Set ChtObj = .ChartObjects.Add(100, 100, 400, 400) ChtObj.Name = "PicFrame" ChtObj.Width = .Shapes("Pic").Width ChtObj.Height = .Shapes("Pic").Height ActiveSheet.Shapes.Range(Array("Pic")).Select Selection.Copy ActiveSheet.ChartObjects("PicFrame").Activate ActiveChart.Paste ActiveChart.Export Filename:=fname, FilterName:="png" ChtObj.Delete ActiveSheet.Shapes.Range(Array("Pic")).Delete End With End Sub 

具有循环程序的子程序,完全是普通的,它给子程序提供一个文件名。

 Public Sub MainRun() Dim i, j, k As Long Dim NMG, NMB As String Dim FNGBSig As String Dim FNUnivSig As String Dim BatchStart, Batch As Long BatchStart = ThisWorkbook.Worksheets(2).Cells(15, 1).Value + 1 Batch = 13 For i = BatchStart To BatchStart + Batch - 1 'Some calculations that refresh values in range A1:L12 FNGBSig = i & "GoodBad.png" PutPic FNGBSig Next i End Sub 

我怀疑循环引起的问题,因为.Export方法运行到自己。 使用WinAPI Sleepfunction插入一个小的延迟(1秒可能就足够了)。 另外,我已经清理了一下代码:

 Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 'For use in timer function Sub PutPic(FN) Dim fname As String Dim shp As Picture Dim ChtObj As ChartObject Dim ws As Worksheet Set ws = ThisWorkbook.Worksheets(2) fname = "E:\Users\ABCD\Documents\EFGH\" & FN 'Copy the range of cells With ws .Range(.Cells(1, 1), .Cells(12, 12)).Copy 'Paste & get a handle on the resulting picture: Set shp = .Pictures.Paste(Link:=False) End With 'Scale your picture: With shp .ShapeRange.ScaleWidth 2, msoFalse, msoScaleFromTopLeft .ShapeRange.ScaleHeight 2, msoFalse, msoScaleFromMiddle End With 'Add the ChtObj frame: Set ChtObj = ws.ChartObjects.Add(100, 100, 400, 400) 'Size the chart, paste the picture in the chart, export With ChtObj .Width = shp.Width .Height = shp.Height shp.Copy Sleep 1000 '1000 milliseconds = 1 second .Chart.Paste .Chart.Export Filename:=fname, FilterName:="png" .Delete End With shp.Delete End Sub 

请注意,这通常是皱眉:

  Dim i, j, k As Long Dim NMG, NMB As String Dim FNGBSig As String Dim FNUnivSig As String Dim BatchStart, Batch As Long 

这声明i as Variant, j as Variant, k as Long等等。要以内联方式执行多个声明,您仍然需要指定数据types:

 Dim i as Long, j as Long, k as Long Dim NMG as String, NMB as String ' etc...