WPS文档中的VBA代码可以分步执行，却无法一键运行

wangzc8332

在WPS文档中利用VBA代码，倒序查找包含“空压机”的段落并将该段和下一段标红，并复制到新的文档中，可以分步执行却无法一键执行，请大佬帮帮忙看看哪里的问题。


Sub 统计包含空压机的段落()
    Dim oDoc As Document '当前文档
    Dim newDoc As Document '新建的文档
    Dim oPara As Paragraph '当前段落
    Dim i As Long '循环计数器
    Dim rng As Range '范围
   
    ' 设置当前文档
    Set oDoc = ActiveDocument
   
    ' 创建新的WPS文档
    Set newDoc = Documents.Add
   
    ' 从后向前遍历每个段落
    For i = oDoc.Paragraphs.Count To 1 Step -1
        Set oPara = oDoc.Paragraphs(i)
        
        ' 检查段落是否包含关键词"空压机"
        If InStr(oPara.Range.Text, "空压机") > 0 Then
            ' 高亮显示当前段落
            oPara.Range.Font.Color = wdColorRed
            
            ' 如果当前段落不是第一个段落，则高亮显示前一个段落
            If i < oDoc.Paragraphs.Count Then
                oDoc.Paragraphs(i - 1).Range.Font.Color = wdColorRed
            End If
            
            
            ' 复制高亮段落到剪贴板
            
          oDoc.Paragraphs(i - 1).Range.Copy
            newDoc.Paragraphs.Last.Range.Paste
      
            oPara.Range.Copy
            newDoc.Paragraphs.Last.Range.Paste
                        
             ' 在新文档的每一个段落后增加换行
            newDoc.Paragraphs.Last.Range.InsertParagraphAfter
        End If
    Next i
   
    ' 保存新文档到桌面
    Dim desktopPath As String
    desktopPath = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\"
    newDoc.SaveAs FileName:=desktopPath & Format(Now, "yyyyMM") & "空压机启停记录.docx", FileFormat:=wdFormatDocumentDefault
   
    ' 关闭新文档
'    newDoc.Close SaveChanges:=False
   
    MsgBox "操作完成，结果已保存到桌面。"
End Sub

wangzc8332

老是报错，newDoc.Paragraphs.Last.Range.Paste语句中的PASTE应用于RANGE对象错误

wangzc8332

newDoc.Paragraphs.Last.Range.Paste这句报错

batmanbbs

.copy和.cut后面需要添加延时，用于将数据完整写入到剪贴板中
PS：建议能不使用.copy就不使用