我有一个宏可以在后端打开一个 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

最佳答案

编辑

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 可能没问题。但是,您的问题可能是您获取的数据与 text 格式不兼容,如下所述。

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

我可以重现特定的错误



对于 Range.PasteSpecial 在以下条件下:
  • 剪贴板是空的
  • 数据不是从办公室复制的
    应用。

  • 原来,有一个办公室剪贴板和一个 Windows 剪贴板。例如,Application.CutCopyMode 只控制办公室剪贴板。 Range.PasteSpecial 在 Office 剪贴板之外工作,而 Workbook.PasteSpecial 在系统或 Windows 剪贴板之外工作。因此,如果办公室剪贴板为空,它不会抛出错误,事实上,如果它被迫使用 Text 作为其格式,它会在相反的条件下抛出错误,即复制 excel 范围。



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

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

    excel - ActiveSheet.PasteSpecial 中的 VBA PasteSpecial 错误-LMLPHP

    由于在不同条件下,一件事或另一件事可能会给您带来不同的问题,因此您可以尝试通过这样的选择来取得进展......
    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 方法为 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
    

    关于excel - ActiveSheet.PasteSpecial 中的 VBA PasteSpecial 错误,我们在Stack Overflow上找到一个类似的问题:https://stackoverflow.com/questions/46571633/

    10-12 19:05