如何修改Word VBA脚本以忽略选区末尾的段落换行符？

你现有的宏可以为选中文本添加智能引号，但选中整个段落时，结尾引号会被错误地放在新行——这是因为选区包含了段落末尾的段落标记（Chr(13)）或换行符（Chr(10)），导致引号被插入到这些标记之后。

原宏代码 #

Option Explicit 
Sub addquotes() 
Dim r As Range 
With ActiveDocument 
     'check for extra spaces and punctuation &
     'select the entire word or phrase
    Set r = Selection.Words(Selection.Words.Count) 
    If r.Characters(r.Characters.Count) = " " Then 
        Set r = .Range(Selection.Words(1).Start, _ 
        Selection.Words(Selection.Words.Count).End - 1) 
    Else 
        Set r = .Range(Selection.Words(1).Start, r.End) 
    End If 
     'check to see if AutoformatasYouType is being used
    If Options.AutoFormatAsYouTypeReplaceQuotes Then 
        r.InsertBefore Chr(147) 
        r.InsertAfter Chr(148) 
    Else 
        r.InsertBefore Chr(34) 
        r.InsertBefore Chr(34) 
    End If 
End With 
 '    select the results as reference...can be commented if not needed
r.Select 
End Sub

问题示例 #

选中以下段落：

If only Uncle Monty knew what we know, Violet said, and Stephano knew that he knew what we know. But Uncle Monty doesn't know what we know, and Stephano knows that he doesn't know what we know.

执行原宏后，结尾引号被放到新行：

“If only Uncle Monty knew what we know,” Violet said, “and Stephano knew that he knew what we know. But Uncle Monty doesn't know what we know, and Stephano knows that he doesn't know what we know.
”

修改后的宏代码 #

Option Explicit 
Sub addquotes() 
Dim r As Range 
With ActiveDocument 
     'check for extra spaces and punctuation &
     'select the entire word or phrase
    Set r = Selection.Words(Selection.Words.Count) 
    If r.Characters(r.Characters.Count) = " " Then 
        Set r = .Range(Selection.Words(1).Start, _ 
        Selection.Words(Selection.Words.Count).End - 1) 
    Else 
        Set r = .Range(Selection.Words(1).Start, r.End) 
    End If 

    ' 移除末尾的段落标记或换行符
    Do While r.End > r.Start And _
        (r.Characters(r.Characters.Count) = Chr(13) Or _
         r.Characters(r.Characters.Count) = Chr(10))
        Set r = .Range(r.Start, r.End - 1)
    Loop

     'check to see if AutoformatasYouType is being used
    If Options.AutoFormatAsYouTypeReplaceQuotes Then 
        r.InsertBefore Chr(147) 
        r.InsertAfter Chr(148) 
    Else 
        r.InsertBefore Chr(34) 
        r.InsertAfter Chr(34) 
    End If 
End With 
 '    select the results as reference...can be commented if not needed
r.Select 
End Sub

关键修改说明 #

1. 新增非文本字符处理逻辑：通过循环检查选区末尾的字符，若为段落标记（Chr(13)）或换行符（Chr(10)），则将选区的结束位置向前移动一位，确保仅包含实际文本内容。
2. 修复引号插入错误：原代码的Else分支中两次使用InsertBefore，会导致两个引号都添加在文本开头，改为InsertAfter后，才能正确在文本末尾添加闭合引号。

内容的提问来源于stack exchange，提问作者bdb484