VBA PasteSpecial错误
我已经做了一个macros，在后端打开一个word文档，并将所有的数据表从word中拖入一个excel模板。 这个macros对我来说工作正常，但是当我在一些同事机器上testing它时，他们得到了“VBA PasteSpecial错误”。 我检查了所有的参考资料，并在我的同事机器中添加了我的资料。 但仍然是，他们得到这个错误，而对我来说，它工作得很好。 有人可以帮助我解决这个错误。 代码如下：
Dim sht As Worksheet Dim WordDoc As Word.Document Dim WordApp As Word.Application Dim i As Long, r As Long, c As Long Dim rng As Range, t As Word.Table Dim ia As Integer Dim OpenForms Dim target As Range ia = 1 Set WordApp = CreateObject("Word.Application") WordApp.Visible = False Set WordDoc = WordApp.Documents.Open(DOC_PATH, ReadOnly:=True) Set sht = Sheets("test") Set rng = sht.Range("A5") sht.Activate For Each t In WordDoc.Tables OpenForms = DoEvents t.Range.Copy OpenForms = DoEvents ThisWorkbook.Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Table_" & ia ' add new sheet Range("a1").Select ' paste table ActiveSheet.PasteSpecial Format:="Text", Link:=False, DisplayAsIcon:=False OpenForms = DoEvents 编辑
OP诊断该问题是并发问题，剪贴板没有及时复制到粘贴操作。 下面的代码将解决这个问题，同时保持响应的用户界面和合理的超时时间和通知。
On Error Resume Next Dim TimeoutLimit TimeoutLimit = 300 Dim TimeoutCounter TimeoutCounter = 0 Do Err.Clear DoEvents 'Yield thread execution ActiveSheet.PasteSpecial Format:="Text", Link:=False, DisplayAsIcon:=False TimeoutCounter = TimeoutCounter + 1 Loop Until (Err.Number = 0 Or TimeoutCounter > TimeoutLimit ) On Error GoTo 0 If TimeoutCounter > TimeoutLimit Then MsgBox "Paste failed because of operation timeout", vbCritical 'Is this fatal? Abort by proper exiting... 'Exit Sub 'Exit Function End If
我认为你使用ActiveSheet.PasteSpecial可能是好的，基于你所做的testing和这个MSDN文档 。 但是，您的问题可能是您获取的数据与text格式不兼容，如下所述。
关于该方法， Worksheet.PasteSpecial方法与Range.PasteSpecial完全不同。 我觉得很奇怪，你得到的错误说，如果你调用工作表方法，范围方法失败。 如果这是正确的，我怀疑工作表方法在某个时刻调用范围方法。
我可以重现具体的错误
Range类的PasteSpecial方法失败
为Range.PasteSpecial在下列条件下：
- 剪贴板是空的
- 数据不是从Office应用程序复制的。
原来，有一个办公室剪贴板和一个Windows剪贴板。 例如， Application.CutCopyMode只控制办公室剪贴板。 Range.PasteSpecial使用Office剪贴板，而Workbook.PasteSpecial使用系统或Windows剪贴板。 所以，如果办公室剪贴板是空的，它不会抛出错误，实际上，如果强制使用Text作为格式，则会出现相反的情况，即在Excel范围被复制时抛出错误。
工作表类的PasteSpecial方法失败
如果剪贴板数据无法转换为文本（如图片），也会引发此错误。 您可以通过不指定格式来处理这个格式，并且将使用默认格式 。 它不一定是文本，但是这可以解决粘贴Excel范围的错误。
为了解决这个问题并检查您的剪贴板内容是如何存储的，请从Excel中查看它，如下所示。
既然在不同的条件下，有一件事或另一件可能会给你带来不同的问题，你可以尝试通过你的select进行这样的…
On Error Resume Next ActiveSheet.Range("A1").PasteSpecial Paste:=xlPasteValues If Err > 0 Then Err.Clear ActiveSheet.PasteSpecial Format:="Text", Link:=False, DisplayAsIcon:=False If Err > 0 Then Err.Clear 'You could also try to manually retrieve data from clipboard at this point ActiveSheet.PasteSpecial End If End If On Error GoTo 0
就像我在评论中所说的那样， PasteSpecial可以很挑剔。 因此，我build议删除作为一个因素，并testing如果你可以直接访问剪贴板内容像下面的代码（ 从这里复制 ）…
Sub GetClipBoardText() Dim DataObj As MSForms.DataObject Set DataObj = New MsForms.DataObject '<~~ Amended as per jp's suggestion On Error GoTo Whoa '~~> Get data from the clipboard. DataObj.GetFromClipboard '~~> Get clipboard contents myString = DataObj.GetText(1) MsgBox myString Exit Sub Whoa: If Err <> 0 Then MsgBox "Data on clipboard is not text or is empty" End Sub
请参阅此logging的案例，说明由于剪贴板为空而造成的相同错误 ，以及Officemacros如何轻松地发生这种情况。 你正在复制你的macros，所以我不希望这是你的问题。 而且，这个代码片段可以防范Range方法的null，但不能保护Worksheet方法，因为它只检查应用程序的剪贴板，而不是系统的。
If Application.CutCopyMode = True Then ActiveSheet.PasteSpecial Format:="Text", Link:=False, DisplayAsIcon:=False Else MsgBox("There is no data on the clipboard to be pasted.") End If
.PasteSpecial是Range对象的方法，而不是Worksheet对象 。 粘贴是Worksheet对象的一种方法。
尝试更换，
ThisWorkbook.Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Table_" & ia ' add new sheet Range("a1").Select ' paste table ActiveSheet.PasteSpecial Format:="Text", Link:=False, DisplayAsIcon:=False
…，
ThisWorkbook.Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Table_" & ia ' add new sheet ActiveSheet.Range("a1").PasteSpecial Format:="Text", Link:=False, DisplayAsIcon:=False