使用 Selection.PasteAndFormat (wdFormatPlainText) 时出现运行时错误 4198

Question

这段代码工作了一段时间，但现在运行时出现 4198 运行时错误。 我需要的是查找并复制给定样式的所有文本（名为问题）并粘贴到文档末尾。

Sub CopyAIRs()

' CopyAIRs Macro

    Dim styl As Style
    Set styl = ActiveDocument.Styles("Questions")
    Dim rng As Range
    Set rng = ActiveDocument.Range
    
    With rng.Find
        .ClearFormatting
        .Style = styl
        .Text = ""
        .Forward = True
        .Wrap = wdFindStop
    End With
    
    Do While rng.Find.Execute
        rng.Select
        With Selection
            .Copy
            .EndKey Unit:=wdStory, Extend:=wdMove
            .MoveUp Unit:=wdLine, Count:=1
            .EndKey Unit:=wdLine
            .TypeParagraph
            .PasteAndFormat (wdFormatPlainText)            
        End With
    Loop
    
End Sub

我检查了剪贴板，它似乎在循环的第一“轮”中工作，但它给出了这个错误。在最近的尝试中，我有 6 个采用这种特定风格的编号段落。 **注意：**在开发者模式下，使用 F8 执行步骤时可以工作，但使用 F5 会出现错误。

Answer 1

• 由于您想收集所有不带格式的文本（wdFormatPlainText），因此不需要

  Copy/Paste

  。

微软文档：

Range.InsertBefore 方法（Word）

Range.InsertParagraphAfter 方法（Word）

Option Explicit
Sub CopyAIRs()
    Dim styl As Style, docRng As Range, endRng As Range
    Set styl = ActiveDocument.Styles("Strong")
    Set docRng = ActiveDocument.Range
    With docRng.Find
        .ClearFormatting
        .Style = styl
        .Text = ""
        .Forward = True
        .Wrap = wdFindStop
    End With
    Do While docRng.Find.Execute
        Set endRng = ActiveDocument.Range.Characters.Last
        If Len(endRng.Paragraphs(1).Range.Text) > 1 Then endRng.InsertParagraphAfter
        endRng.InsertBefore docRng.Text
    Loop
End Sub