2016-09-28 204 views
1

我一直在運行剪切和粘貼圖片例程一段時間,所有的突然Excel開始給我這個運行時錯誤。到目前爲止,它一直工作正常,沒有操作系統更新或重新啓動,儘管我嘗試關閉並重新打開Excel以查看它是否有幫助。更奇怪的是,腳本執行了批量複製和paste.picture,相同範圍(帶有重新計算的值)被複制並粘貼了13次,並且錯誤消息通常在最後一個循環或偶爾在某個隨機點彈出。Excel 2010 VBA:運行時錯誤1004,Microsoft Excel無法粘貼數據

我擡頭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(cells(1,1),cells(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 
+2

請發佈您正在使用的代碼。 –

+1

只需使用目標的左上角單元格。其餘的單元格將粘貼在相鄰的單元格中。 – Jeeped

+0

此外,錯誤消息(並進入調試)後,我可以手動粘貼圖片。 – user110084

回答

1

我懷疑爲.Export方法在自身運行循環導致了問題。使用WinAPI Sleep函數插入一個小延遲(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等爲直列做多的聲明,你仍然需要指定數據類型:

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

謝謝@davidzemens。也欣賞不良練習的指導。 – user110084

+0

不用擔心,這是一個普遍的疏忽:) –

+0

對不起,我還沒有能夠運行你的代碼,但將在幾個小時內這樣做。您對DIM的指導實際上幫助解決了另一個問題 - 儘管如此,在調用subs和函數時,我仍然在未聲明的變量中出現錯誤。我確實必須將每個變量分成它自己的DIM。現在我明白爲什麼我所做的只是皺眉了! – user110084