Word 宏用换行符替换段落标记

Question

美好的一天，

我需要将所有诗歌行中的段落标记替换为换行符，除了每首诗歌摘录中的最后一行，样式为“引用诗人”。 当只有一行时，不应有任何变化。

这里是示例文本，RS Vol 1 B1 (2022 04 09) - 链接导入 3d.docx https://drive.proton.me/urls/YHMZ9BCNGM#jt39eAAjcpgq

我创建了一个 Word 宏来执行此操作，但效果不佳。

有人可以帮忙吗？

这是代码：

Sub ParaBreakToLineBreak()
'
' ParaBreakToLineBreak Macro
' ParaBreakToLineBreak Style = "quote poet"     Selection.MoveLeft Unit:=wdCharacter, Count:=1
'

    ' Go to start of document
    Selection.HomeKey Unit:=wdStory

Do

For Each Paragraph In ActiveDocument.Paragraphs

    Selection.Find.ClearFormatting
    Selection.Find.Style = ActiveDocument.Styles("quote poet")
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "^$"
    End With
    Selection.Find.Execute
    
    If Paragraph.Next.Style = "quote poet" Then
                
    Selection.MoveUp Unit:=wdLine, Count:=1
    Selection.HomeKey Unit:=wdLine
    
    Selection.Find.ClearFormatting
    Selection.Find.Style = ActiveDocument.Styles("quote poet")
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Style = ActiveDocument.Styles("quote poet")
    With Selection.Find
        .Text = "^p"
        .Replacement.Text = "^l"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
    End With
      
    Selection.Find.Execute
    With Selection
        If .Find.Forward = True Then
            .Collapse Direction:=wdCollapseStart
        Else
            .Collapse Direction:=wdCollapseEnd
        End If
        .Find.Execute Replace:=wdReplaceOne
        If .Find.Forward = True Then
            .Collapse Direction:=wdCollapseEnd
        Else
            .Collapse Direction:=wdCollapseStart
        End If
        .Find.Execute
    End With
    
    Else
    Selection.MoveDown Unit:=wdLine, Count:=1
'   Paragraph.Next.Style = "Body Text First Indent1"
    
    End If
  
    Next
    
    Selection.MoveDown Unit:=wdLine, Count:=1
        
    Loop Until Selection.Range.End = ActiveDocument.Range.End

End Sub

Answer 1

尝试以下操作：

Sub ParaBreakToLineBreak()
    With ActiveDocument.Content
        With .Find
            .ClearFormatting
            .Replacement.ClearFormatting
            .Format = True
            .Style = ActiveDocument.Styles("quote poet")
        End With
        Do While .Find.Execute
            If .Next(wdParagraph).Style = "quote poet" Then
                .Characters.Last = Chr(11)
            End If
        Loop
    End With
End Sub