您的位置: 首页  >  技术问答  >  Excel 2010 VBA：运行时错误1004，Microsoft Excel无法粘贴数据

Excel 2010 VBA：运行时错误1004，Microsoft Excel无法粘贴数据

分类: 技术问答 • 2022-05-25 16:34:09
问题描述：

我已经运行了剪切和粘贴图片程序一段时间，突然间Excel开始给我这个运行时错误。到目前为止，它已经运行了好几天（没有操作系统更新或重新启动，尽管我确实尝试关闭并重新打开Excel以查看它是否有帮助）。仍然很陌生，脚本会批量复制和粘贴图片，将相同范围（带有重新计算的值）复制并粘贴13次，并且错误消息通常会在最后一个循环中弹出，有时会在某个随机点弹出。

I had been running a cut and paste picture routine for some time and all of a sudden Excel starting giving me this run time error. It had been working fine for several days until now (no OS update or reboot, though I did try closing and reopening Excel to see if it helped). Stranger still, the script does a batch copy and paste.picture, the same range (with recalculated values) is copied and pasted 13 times and the error message pops up usually in the last loop or occasionally at some random point.

我查找了support.microsoft.com/zh-cn/kb/905164：
如果满足以下任一条件，则可能会出现此问题：

I looked up support.microsoft.com/en-us/kb/905164: "This issue may occur if either of the following conditions is true:

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（cells（1,1），cells（12,12）），但这些方法都无济于事。

However, I am copying a range of 12,12 cells, from A1 to L12 to be exact, not even close to an entire row. I have tried using range.offset, xldown, rannge(cells(1,1), cells(12,12)) but none of these helped.

有人经历过吗？ 

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 Sleep 函数插入一小段延迟（大概一秒钟就足够了）。另外，我还清理了一下代码：

I suspect the loop is causing the issue as the .Export method is running in to itself. Use the WinAPI Sleep function to insert a small delay (1 second is probably enough). Also, I've cleaned up the code a little bit:

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

请注意，这通常被皱眉：

Note that this is generally frowned upon:

 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为Variant，j为Variant，k为Long ，等等。要内联执行多个声明，您仍然需要指定数据类型：

This declares i as Variant, j as Variant, k as Long, etc. To do multiple declarations inline, you still need to specify the data type:

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

相关推荐