InStr() 无法识别智能引号

Smart quotations aren't recognized by InStr()

我有这样的代码:

Sub MoveToBeginningSentence()
    Application.ScreenUpdating = False
    Dim selectedWords As Range
    Dim selectedText As String
    Const punctuation As String = " & Chr(145) & "
    On Error GoTo ErrorReport
     ' Cancel macro when there's no text selected

    Selection.Cut
    Selection.MoveLeft Unit:=wdSentence, Count:=1, Extend:=wdMove
    Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    Set selectedWords = Selection.Range
    selectedText = selectedWords
    If InStr(selectedText, punctuation) = 0 Then
        Selection.MoveLeft Unit:=wdSentence, Count:=1, Extend:=wdMove
        Selection.Paste
    Else
        Selection.MoveLeft Unit:=wdSentence, Count:=1, Extend:=wdMove
        Selection.Paste
        Selection.Paste
        Selection.Paste
        Selection.Paste
    End If

ErrorReport:

End Sub

基本上,它帮助我将我选择的任何文本移动到 Word 中句子的开头。如果没有引号,则粘贴一次。如果有引号,则粘贴4次。

问题是不管有没有引用,都只会贴一次。如果我将宏设置为检测任何其他字符,它将正常工作。但每次我试图强制它检测智能报价时,它都会失败。

有什么办法可以解决吗?

您需要提供 InStr 起始位置作为第一个参数:

If InStr(1, selectedText, punctuation) = 0 Then

还有

Const punctuation As String = " & Chr(145) & "

将搜索 space-ampersand-space-Chr(145)-space-ampersand-space。如果要搜索智能引号字符,请使用

Const punctuation As String = Chr(145)

希望对您有所帮助。

请查看此代码。

Sub MoveToBeginningSentence()
    ' 19 Jan 2018

    Dim Rng As Range
    Dim SelText As String
    Dim Repeats As Integer
    Dim i As Integer

    With Selection.Range
        SelText = .Text                     ' copy the selected text
        Set Rng = .Sentences(1)             ' identify the current sentence
    End With

    If Len(SelText) Then                    ' Skip when no text is selected
        With Rng
            Application.ScreenUpdating = False
            Selection.Range.Text = ""       ' delete the selected text
            Repeats = IIf(IsQuote(.Text), 4, 1)
            If Repeats = 4 Then .MoveStart wdCharacter, 1
            For i = 1 To Repeats
                .Text = SelText & .Text
            Next i
            Application.ScreenUpdating = True
        End With
    Else
        MsgBox "Please select some text.", _
               vbExclamation, "Selection is empty"
    End If
End Sub

Private Function IsQuote(Txt As String) As Boolean
    ' 19 Jan 2018

    Dim Quotes
    Dim Ch As Long
    Dim i As Long

    Quotes = Array(34, 147, 148, -24143, -24144)
    Ch = Asc(Txt)
'    Debug.Print Ch                      ' read ASCII code of first character
    For i = 0 To UBound(Quotes)
        If Ch = Quotes(i) Then Exit For
    Next i
    IsQuote = (i <= UBound(Quotes))
End Function

采用的方法是使用 ASC() 函数识别所选句子的第一个字符。对于 34 的正常引号。在我的测试中,我想出了 -24143 和 -24144(打开和关闭)。我无法识别 Chr(145),但发现 MS 指出弯引号分别是 Chr(147) 和 Chr(148)。因此我添加了一个检查所有这些的功能。如果在函数中启用 Debug.Print Ch 行,实际找到的字符代码将打印到立即 window。您可以向数组 Quotes.

添加更多字符代码

代码本身不考虑单词之间的空格。也许 Word 会解决这个问题,也许您不需要它。

使用 Selection 对象总是有点偶然;总的来说,最好使用 Range 对象。您只能选择一个;您可以根据需要拥有任意数量的范围。

因为您的代码使用了 Selection 对象,所以并不是 100% 清楚代码的作用。根据我的最佳猜测,我整理了以下示例,如果它不完全正确,您可以进行调整。

一开始,我检查选区中是否有东西,或者它是一个闪烁的插入点。如果没有选择文本,则宏结束。这比调用错误处理然后不处理任何东西要好:如果您的代码中出现其他问题,您不会知道它们。

Range 对象已为选择实例化 - 没有必要 "cut" 它,您将在后面看到。基于此,整个句子也被分配给一个Range对象。句子的文本被拾取,那么句子的Range就是"collapsed"到它的起点。 (把这想象成按下键盘上的向左箭头。)

现在检查句子的文本是否有字符 Chr(145)。如果不存在,则将原始选择的文本(包括格式)添加到句子的开头。如果存在,则添加四次。

最后,原来的选择被删除了。

Sub MoveToBeginningSentence()
    Application.ScreenUpdating = False
    Dim selectedText As String
    Dim punctuation As String
    punctuation = Chr(145)  ' ‘ "smart" apostrophe
    Dim selRange As word.Range
    Dim curSentence As word.Range
    Dim i As Long

   ' Cancel macro when there's no text selected
   If Selection.Type = wdSelectionIP Then Exit Sub

    Set selRange = Selection.Range
    Set curSentence = selRange.Sentences(1)
    selectedText = curSentence.Text
    curSentence.Collapse wdCollapseStart
    If InStr(selectedText, punctuation) = 0 Then
        curSentence.FormattedText = selRange.FormattedText
    Else
        For i = 1 To 4
            curSentence.FormattedText = selRange.FormattedText
            curSentence.Collapse wdCollapseEnd
        Next
    End If
    selRange.Delete
End Sub