Получить текст полного диапазона в строку - PullRequest
Новая
       39

Получить текст полного диапазона в строку

2 голосов
/ 27 мая 2020

Я пишу сценарий, который просматривает мои исходящие электронные письма и выявляет частые стилистические c ошибки, которые я делаю. Он находит их с помощью регулярного выражения, а затем выделяет их желтым цветом. Код: 

Public Sub highlightBadForm()

    Dim oWordDoc As Object
    Dim oMatches As Object
    Dim oRange As Range
    Dim strText As String
    Dim lngFindFrom As Long
    Dim varMtch As Variant

    Set oWordDoc = Application.ActiveInspector.WordEditor
    strText = LCase(oWordDoc.Range.Text)

    lngFindFrom = InStr(strText, "from: ")
    If lngFindFrom > 0 Then
        strText = Left(strText, lngFindFrom - 1)
    End If

    Set oMatches = extractMatches(strText, getBadStrs)
    If Not oMatches Is Nothing Then
        For Each varMtch In oMatches
                Set oRange = oWordDoc.Range(varMtch.firstindex, varMtch.firstindex + varMtch.Length)
                oRange.HighlightColorIndex = wdYellow
        Next varMtch
    End If

    Set oRange = Nothing
    Set oWordDoc = Nothing
    Set oMatches = Nothing
End Sub

extractMatches - это частная функция, реализующая механизм RegEx VBA. getBadStrs возвращает регулярное выражение, содержащее ошибки.

Все работает, если я не встроил гиперссылки в свою электронную почту. Если это так, oWordDoc.Range.Text возвращает только текст привязки ссылок, а не ссылки (и любые другие символы, которыми Word дополняет гиперссылки - я не знаю, что это могут быть). В результате varMtch.firstindex подходит для strText, но не oRange, поэтому текст, который он выделяет, смещен на несколько символов.

Я попытался собрать полный текст oRange, перебирая гиперссылки в oRange и добавив текст ссылки в строку, предполагая, что он будет включен в oRange. Что-то вроде: 

Dim lngEndLnk as Long
Set oRange = oWordDoc.Range

For Each varMtch In oRange.Hyperlinks
    strText = strText & oWordDoc.Range(lngEndLnk, varMtch.Range.Start)
    strText = strText & varMtch.TextToDisplay & varMtch.Name
    lngEndLnk = varMtch.Range.End
Next varMtch

If lngEndLnk = 0 Then
    strText = oRange.text
Else
    strText = strText & oWordDoc.Range(lngEndLnk, oWordDoc.Range.End)
End If

Это уменьшило смещение, но оно все еще есть. Кроме того, если бы я включил связанное изображение в электронное письмо, свойство .Anchor для varMtch не сработает, поэтому мне пришлось бы найти другое обходное решение.

Есть ли более простой способ получить String, содержащий все символы объекта Range, чтобы индексы регулярных выражений выровнялись?

Ответы [ 3 ]

1 голос
/ 30 мая 2020

В итоге я получил аналогичное решение для @slightly snarky. Не знаю, что лучше, поэтому отмечать это как решение не буду. Рад за комментарии о плюсах и минусах, если есть явный победитель, которого я просто не вижу.

Лично мне нравится зацикливать коллекцию символов и, вероятно, следует использовать его в моем коде, это работает. Я считаю использование массива позиций для выделения совпадений гораздо менее интуитивным, чем построение строки из диапазона. Для моих целей заполнение строки # вместо символов нулевой длины в oWordDoc.Range работает, но я также знаю, что это не сработает для всех. 

Public Sub highlightBadForm()

    Dim oWordDoc As Object
    Dim oMatches As Object
    Dim oRange As Range
    Dim strText As String
    Dim lngFindFrom As Long, lngC As Long, lngPrevLen As Long
    Dim varMtch As Variant

    Set oWordDoc = Application.ActiveInspector.WordEditor

    For lngC = 0 To oWordDoc.Range.End - 1
        strText = strText & oWordDoc.Range(lngC, lngC + 1)
        If Len(strText) = lngPrevLen Then
            strText = strText & "#"
        End If
        lngPrevLen = lngPrevLen + 1
    Next lngC
    strText = LCase(strText)

    lngFindFrom = InStr(strText, "from: ")
    If lngFindFrom > 0 Then
        strText = Left(strText, lngFindFrom - 1)
    End If

    Set oMatches = extractMatches(strText, getBadStrs)
    If Not oMatches Is Nothing Then
        For Each varMtch In oMatches
                Set oRange = oWordDoc.Range(varMtch.FirstIndex, varMtch.FirstIndex + varMtch.Length)
                oRange.HighlightColorIndex = wdYellow
        Next varMtch
    End If

    Set oRange = Nothing
    Set oWordDoc = Nothing
    Set oMatches = Nothing
End Sub
0 голосов
/ 29 мая 2020

Ключ к этому, кажется, заключается в том, что когда вы перебираете Range, глядя на каждую «позицию» в диапазоне, например, через что-то вроде 

With ActiveDocument.Range
  For i = 0 to .End - 1
    Debug.Print i,Ascw(.Range(i,i+1).Text)
  Next
End With

Range действительно содержит все символы в коде поля, такого как поле ГИПЕРССЫЛКА, и все символы в его результате (который может быть отображен или может быть скрытым текстом). Но в некоторых случаях Range может содержать дополнительные символы, которые никогда не отображаются. Например, если у вас есть код поля, такой как {SET x 123}, тогда диапазон содержит то, что фактически является скобками поля и кодом «SET X 123», но перед конечной скобкой поля он также содержит маркер, за которым следует значение «123». Но поле SET не отображает его результат.

Это затрудняет построение строки "find" той же длины, что и Range.

Но Range.Text - это тот же текст, что и конкатенация всех символы в Range.Characters, и каждый символ в этой коллекции - это диапазон, который содержит позицию .Start

. Это позволяет нам получить .Start и .End, как показано в следующем примере.

Предполагается, что вы работаете с ActiveDocument в Word и имеете некоторый текст, поле ГИПЕРССЫЛКИ (скажем) и, возможно, другие поля с текстом «test1» в разных местах.

Я не проводил большого количества тестов, так что, возможно, его еще нужно настроить. 

Sub HighlightFinds()
Dim match As VBScript_RegExp_55.match
Dim matches As VBScript_RegExp_55.MatchCollection
Dim rng1 As Word.Range
Dim rng2 As Word.Range
Set rng1 = ActiveDocument.Content
Set rng2 = ActiveDocument.Content ' or rng1.Duplicate

' When you do this, rng1.Text returns the text of the field *codes* but
' not the field *results*, and so does rng1.Characters
'rng1.TextRetrievalMode.IncludeFieldCodes = True
' when you do this, it returns the *results* but not the *codes*
rng1.TextRetrievalMode.IncludeFieldCodes = False

' You could do both, one after the other, to try to get all the matches

' You might also need to set .TextRetrievalMode.IncludeHiddenText

With New VBScript_RegExp_55.RegExp
  .Pattern = "test1"
  .Global = True
  Set matches = .Execute(rng1.Text)
End With
For Each match In matches
  rng2.SetRange rng1.Characters(match.FirstIndex + 1).Start, rng1.Characters(match.FirstIndex + 1 + match.Length).End
  rng2.HighlightColorIndex = wdYellow
Next
Set matches = Nothing
Set rng2 = Nothing
Set rng1 = Nothing
End Sub
0 голосов
/ 27 мая 2020

Вы можете получить доступ к адресу гиперссылки, используя коллекцию hyperlinks документа: 

Private Sub CommandButton1_Click()
    strtext = ActiveDocument.Range.Text
    MsgBox (strtext)
    For Each hLink In Documents(1).Hyperlinks
     MsgBox (hLink.Address)
    Next hLink
End Sub

Это сначала отображает весь текст в документе, а затем перебирает каждую гиперссылку, отображая ее URL.

Затем его можно использовать с помощью вашего RegEx.

Для получения дополнительной информации и примеров см. гиперссылки .

...