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
我有这样的代码:
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