我有一个宏可以在后端打开一个 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 中查看它,如下所示。
由于在不同条件下,一件事或另一件事可能会给您带来不同的问题,因此您可以尝试通过这样的选择来取得进展......
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/