excel - ActiveSheet.PasteSpecial 中的 VBA PasteSpecial 错误

Question

我有一个宏可以在后端打开Word文档并将所有数据表拉入Excel模板。

当我在一些同事的机器上测试它时，他们收到“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

Answer 1

编辑

OP 将问题诊断为并发问题，即剪贴板未及时复制以进行粘贴操作。下面的代码将解决此问题，同时保持响应式 UI 以及合理的超时和通知。

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

<小时/>

根据您所做的测试和此 MSDN Documentation，我认为您对 ActiveSheet.PasteSpecial 的使用可能没问题。 。但是，您的问题可能是您获取的数据与文本格式不兼容，如下所述。

就方法而言，Worksheet.PasteSpecial 方法与Range.PasteSpecial 完全不同。我觉得奇怪的是，如果您调用工作表方法，您收到的错误表明范围方法失败。如果这是准确的，我怀疑 Worksheet 方法在某个时刻调用了 range 方法。

我可以重现具体错误

PasteSpecial method of Range class failed

对于 Range.PasteSpecial 在以下条件下:

• 剪贴板为空
• 数据不是从 Office 复制的应用。

事实证明，有一个 Office 剪贴板和一个 Windows 剪贴板。例如，Application.CutCopyMode 仅控制办公室剪贴板。 Range.PasteSpecial 在 Office 剪贴板中工作，而 Workbook.PasteSpecial 在系统或 Windows 剪贴板中工作。因此，如果 Office 剪贴板为空，它不会抛出错误，事实上，如果强制使用 Text 作为格式，它会在复制 Excel 范围的相反情况下抛出错误。

PasteSpecial method of Worksheet class failed

如果剪贴板数据无法转换为文本(如图片)，它也会抛出此错误。您可以通过不指定格式并使用默认格式来处理此问题。那么它不一定是文本，但这解决了粘贴 Excel 范围的错误。

要说明这一点并检查剪贴板内容的存储方式，请从 Excel 中进行查看，如下所示。

由于在不同条件下，一件事或另一件事可能会给您带来不同的问题，因此您可以尝试通过这样的选项来取得进展......

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 可能很挑剔。因此，我建议删除它作为一个因素并测试您是否可以直接访问剪贴板内容，如下面的代码( copied from here )...

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

查看此documented case of the same error这是由于剪贴板为空而导致的，而且使用 Office 宏很容易发生这种情况。您正在宏中复制，所以我不认为这是您的问题。此外，此代码片段将防止 Range 方法出现空值，但不会防止 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