宏错误 - Microsoft Word - 运行时错误'1004'：工作表类错误的粘贴方法失败

我试图运行脚本来搜索关键字，然后复制找到该关键字的整个句子，并将其粘贴在Excel电子表格上。宏错误 - Microsoft Word - 运行时错误'1004'：工作表类错误的粘贴方法失败

当我运行一个文件是1-2页的剧本，它运行良好，但是当我尝试更长的文档（100页以上），我收到以下错误：

运行 - 时间错误'1004'：Worksheet类的粘贴方法失败。当我点击“调试”它说“objsheet.paste”是问题。

你能帮我解决一下代码，以便它可以处理更长的文本吗？

Sub FindWordCopySentence() 
    Dim appExcel As Object 
    Dim objSheet As Object 
    Dim aRange As Range 
    Dim intRowCount As Integer 
    intRowCount = 1 
    Set aRange = ActiveDocument.Range 
    With aRange.Find 
     Do 
      .Text = "Hair" 
      .Execute 
      If .Found Then 
       aRange.Expand Unit:=wdSentence 
       aRange.Copy 
       aRange.Collapse wdCollapseEnd 
       If objSheet Is Nothing Then 
        Set appExcel = CreateObject("Excel.Application") 
             Set objSheet = appExcel.workbooks.Open("C:\Users\HNR\Desktop\hair.xlsx").Sheets("Sheet1") 
        intRowCount = 1 
       End If 
       objSheet.Cells(intRowCount, 1).Select 
       objSheet.Paste 
       intRowCount = intRowCount + 1 
      End If 
     Loop While .Found 
    End With 
    If Not objSheet Is Nothing Then 
     appExcel.workbooks(1).Close True 
     appExcel.Quit 
     Set objSheet = Nothing 
     Set appExcel = Nothing 
    End If 
    Set aRange = Nothing 
End Sub

来源

2017-04-12 IrisRose

对不起，我尝试粘贴代码，它都混杂在一个段落。我不知道如何解决这个问题（刚刚接触论坛，刚刚学会了今天的'宏'来试试这段代码）。我不知道如何以正确的格式发布代码。：\但我编辑原始文章与混乱的文本（和原始代码的链接，如果你点击它，并以正确的格式向下滚动它）。 – IrisRose

一旦你将代码加入问题中，你需要将每行缩进4个空格，使其看起来不错。 Ctrl-K是一个快捷键。 – YowE3K

FWIW - 我猜测打开工作簿导致剪贴板被清除是不正确的。 – YowE3K

如果该问题是由于复制/粘贴的信息，可以通过只需直接分配文本回避：

Sub FindWordCopySentence() 
    Dim appExcel As Object 
    Dim objSheet As Object 
    Dim aRange As Range 
    Dim intRowCount As Integer 
    Dim myTempText As String 
    intRowCount = 1 
    Set aRange = ActiveDocument.Range 
    With aRange.Find 
     Do 
      .Text = "Hair" 
      .Execute 
      If .Found Then 
       aRange.Expand Unit:=wdSentence 
       'Store the text into a variable 
       myTempText = aRange.Text 
       aRange.Collapse wdCollapseEnd 
       If objSheet Is Nothing Then 
        Set appExcel = CreateObject("Excel.Application") 
        Set objSheet = appExcel.workbooks.Open("C:\Users\HNR\Desktop\hair.xlsx").Sheets("Sheet1") 
        intRowCount = 1 
       End If 
       'Set the destination cell to the text we stored 
       objSheet.Cells(intRowCount, 1).Value = myTempText 
       intRowCount = intRowCount + 1 
      End If 
     Loop While .Found 
    End With 
    If Not objSheet Is Nothing Then 
     appExcel.workbooks(1).Close True 
     appExcel.Quit 
     Set objSheet = Nothing 
     Set appExcel = Nothing 
    End If 
    Set aRange = Nothing 
End Sub

问题的另一个潜在原因是，如果你是在处理大文档时感到厌烦，因此您在后台执行其他复制/粘贴操作时将其放在后台运行。

Copy和Paste共享与其他应用程序剪贴板上，这样，如果你在代码做了Copy，当它做它Paste，它会试图Paste你复制，而不是它所复制之间的副本。

因此，尽可能避免在代码中使用复制/粘贴。

来源

2017-04-12 20:30:46 YowE3K

宏错误 - Microsoft Word - 运行时错误'1004'：工作表类错误的粘贴方法失败

回答

相关问题