Разумно ли меняете форматирование пробелов в соответствии с форматированием смежных областей?

Question

Microsoft Word позволяет искать форматированный текст и заменять его и форматирование. Эта функция великолепна в моей работе, когда мне нужно конвертировать документы Word в онлайн-опросы. Простой пример - найти bold слово и заменить его <strong>bold</strong> .

Однако есть случаи, когда документ, который мы получаем, имеет постороннее, неформатированное пустое пространство между указанным форматированием. Это усложняет процесс поиска и замены всего жирного текста. Кроме того, в некоторых случаях форматирование пустого пространства применяется в тех случаях, когда это не так.

Что такое поиск или замена макроса или подстановочного знака (регулярного выражения), чтобы найти и заменить все пустое пространство с неправильным форматированием с правильно отформатированным пустым пространством?

Два критерия "неправильно" - это то, что последний пробел в строке должен быть неформатирован, а пробел между двумя отформатированными словами должен быть отформатирован. По сути, я пытаюсь создать максимально чистый Replace All.

Возьмите следующий скриншот в качестве примера:

Розовые / фиолетовые блики представляют собой пробел, который является нормальным стилем, но должен быть выделен курсивом.

Красная / оранжевая подсветка представляет пустое пространство, которое выделено жирным шрифтом, но должно быть в обычном, не жирном стиле.

В обоих случаях мне понадобится макрос или подстановочный знак найти / заменить, чтобы знать, как преобразовать один в курсив и полностью удалить стиль жирного шрифта из другого.

Для дальнейшего разъяснения:

В настоящее время, если я выполняю поиск и замену всех, используя только стиль шрифта Microsoft Word, это приводит к трем элементам <em> в некоторых строках, например:

<em>The average American expects the rate of deflation (opposite</em> <em>of</em> <em>inflation)</em> will be between 0% and 2%

Идеальный результат - один элемент <em> :

<em>The average American expects the rate of deflation (opposite of inflation)</em> will be between 0% and 2%

(Обратите внимание, что я использую курсив и жирный шрифт в качестве примеров, но то же самое можно сказать и о подчеркивании текста.)

Answer 1

"Подстановочный знак" Word для поиска и замены использует (очень) ограниченную, нестандартную форму регулярных выражений. В сочетании с тем фактом, что вы также хотите найти и заменить форматы, это означает, что невозможно делать то, что вам нужно, просто используя встроенные команды поиска и замены, с подстановочными знаками или нет.

Тем не менее, можно использовать находку в Word / заменить в макрос для выполнения интеллектуального преобразования белого пространства. Также можно написать макрос, используя только правильное регулярное выражение, доступное для VBA, без доступа к поиску / замене Word.

Следующее решение выполняет первое и использует объект Find для программного поиска и замены Word без использования подстановочных знаков. Однако он использует регулярные выражения VBA (или, точнее, VBScript) в паре вспомогательных функций, чтобы упростить их.

Вместо того, чтобы просто преобразовать пустое пространство надлежащим образом, что затем потребовало бы дальнейшего поиска и замены всех шагов, скрипт эффективно преобразовывает пустое пространство и одновременно выполняет обтекание HTML и удаление формата.

'============================================================================================
' Module     : <in any standard module>
' Version    : 0.1.4
' Part       : 1 of 1
' References : Microsoft VBScript Regular Expressions 5.5   [VBScript_RegExp_55]
' Source     : https://superuser.com/a/1321448/763880
'============================================================================================
Option Explicit

Private Const s_BoldReplacement = "<strong>^&</strong>"
Private Const s_ItalicReplacement = "<em>^&</em>"
Private Const s_UnderlineReplacement = "<u>^&</u>"

Private Enum FormatType
  Bold
  Italic
  Underline
End Enum

Public Sub ConvertFormattedTextToHTML()

  With Application
    .ScreenUpdating = True ' Set to False to speed up execution for large documents
    ConvertTextToHTMLIf Bold
    ConvertTextToHTMLIf Italic
    ConvertTextToHTMLIf Underline
    .ScreenUpdating = True
  End With

End Sub

Private Sub ConvertTextToHTMLIf _
            ( _
                       ByVal peFormatType As FormatType _
            )

  ' Create/setup a Find object
  Dim rngFound As Range: Set rngFound = ActiveDocument.Content
  With rngFound.Find
    .MatchCase = True ' Required, otherwise an all-caps found chunk's replacement is converted to all-caps
    .Format = True
    Select Case peFormatType
      Case FormatType.Bold:
        .Font.Bold = True
        .Replacement.Font.Bold = False
        .Replacement.Text = s_BoldReplacement
      Case FormatType.Italic:
        .Font.Italic = True
        .Replacement.Font.Italic = False
        .Replacement.Text = s_ItalicReplacement
      Case FormatType.Underline:
        .Font.Underline = True
        .Replacement.Font.Underline = False
        .Replacement.Text = s_UnderlineReplacement
    End Select
  End With

  ' Main "chunk" loop:
  ' - Finds the next chunk (contiguous appropriately formatted text);
  ' - Expands it to encompass the following chunks if only separated by unformatted grey-space (white-space + punctuation - vbCr - VbLf)
  ' - Removes (and unformats) leading and trailing formatted grey-space from the expanded-chunk
  ' - Converts the trimmed expanded-chunk to unformatted HTML
  Do While rngFound.Find.Execute() ' (rngFound is updated to the "current" chunk if the find succeeds)
    If rngFound.End = rngFound.Start Then Exit Do ' ## bug-workaround (Bug#2 - see end of sub) ##
    ' Create a duplicate range in order to track the endpoints for the current chunk's expansion
    Dim rngExpanded As Range: Set rngExpanded = rngFound.Duplicate
    rngFound.Collapse wdCollapseEnd ' ## bug-workaround (Bug#2 - see end of sub) ##
    ' Expansion loop
    Do
      ' If more chunks exist ~> the current chunk is fully expanded
      If Not rngFound.Find.Execute() Then Exit Do ' (rngFound is updated to the next chunk if the find succeeds)
      If rngFound.End = rngFound.Start Then Exit Do ' ## bug-workaround (Bug#2 - see end of sub) ##
      ' If the formatting continues across a line boundary ~> terminate the current chunk at the boundary
      If rngFound.Start = rngExpanded.End And rngExpanded.Characters.Last.Text = vbCr Then Exit Do ' ## requiring the vbCr check is a bug-workaround (Bug#1 - see end of sub) ##
      ' If the intervening (unformatted) text doesn't just consist of grey-space ~> the current chunk is fully expanded
      ' (Note that since vbCr & vbLf aren't counted as grey-space, chunks don't expand across line boundaries)
      If NotJustGreySpace(rngFound.Parent.Range(rngExpanded.End, rngFound.Start)) Then Exit Do
      ' Otherwise, expand the current chunk to encompass the inter-chunk (unformatted) grey-space and the next chunk
      rngExpanded.SetRange rngExpanded.Start, rngFound.End
      rngFound.Collapse wdCollapseEnd ' ## bug-workaround (Bug#2 - see end of sub) ##
    Loop
    With rngExpanded.Font
      ' Clear the appropriate format for the expanded-chunk
      Select Case peFormatType
        Case FormatType.Bold:           .Bold = False
        Case FormatType.Italic:       .Italic = False
        Case FormatType.Underline: .Underline = False
      End Select
    End With
    With TrimRange(rngExpanded) ' (rngExpanded also gets updated as a side-effect)
      With .Font
        ' Restore the appropriate format for the trimmed expanded-chunk
        Select Case peFormatType
          Case FormatType.Bold:           .Bold = True
          Case FormatType.Italic:       .Italic = True
          Case FormatType.Underline: .Underline = True
        End Select
        ' (Leading and trailing grey-space is now unformatted wrt the appropriate format)
      End With
      ' Unformat the trimmed expanded-chunk and convert it to HTML
      If .Start = .End _
      Then ' ~~ Grey-space Only ~~
        ' Don't convert. (Has already been unformatted by the previous trim)
      Else ' ~~ Valid Text ~~
        ' Need to copy the trimmed expanded-chunk endpoints back to rngFound as we can't use rngExpanded for the replace
        ' since a duplicate's Find object gets reset upon duplication.
        rngFound.SetRange .Start, .Start ' ## Second .Start instead of .End is a bug-workaround (Bug#2 - see below) ##
        rngFound.Find.Text = rngExpanded.Text ' ## bug-workaround (Bug#2 - see end of sub) ##
        rngFound.Find.Execute Replace:=wdReplaceOne
        rngFound.Find.Text = vbNullString ' ## bug-workaround (Bug#2 - see end of sub) ##
      End If
      rngFound.Collapse wdCollapseStart ' ## bug-workaround (Bug#1 & Bug#2 - see end of sub) ##
    End With
  Loop

  ' ## Bug#1 ## Normally, after a range has been updated as a result of performing the Execute() method to *find*
  ' something, performing a second "find" will continue the search in the rest of the document. If, however, the range
  ' is modified in such a way that the same find would not succeed in the range (as is what typically happens when using
  ' Execute() to perform a find/replace), then a second "find" will *NOT* continue the search in the rest of the
  ' document and fails instead. The solution is to "collapse" the range to zero width. See the following for more info:
  ' http://web.archive.org/web/20180512034406/https://gregmaxey.com/word_tip_pages/words_fickle_vba_find_property.html

  ' ## Bug#2 ## Good ol' buggy Word sometimes decides to split a chunk up even though it doesn't cross a line boundary.
  ' Also, even when the Find object's wrap property is set to wdFindStop (default value), it sometimes behaves as if the
  ' property is set to wdFindContinue, which is also buggy, resulting in Execute() not returning False when no more
  ' chunks exist after wrapping (and *correctly* not updating rngFound). This requires a few work-arounds to cater for
  ' all the resulting combination of edge cases.
  ' See the following for a example doc reproducing this bug:
  ' https://drive.google.com/open?id=11Z9fpxllk2ZHAU90_lTedhYSixQQucZ5
  ' See the following for more details on when this occurs:
  ' https://chat.stackexchange.com/rooms/77370/conversation/word-bug-finding-formats-in-line-before-table

End Sub

' Note that vbCr & vbLf are NOT treated as white-space.
' Also note that "GreySpace" is used to indicate it is not purely white-space, but also includes punctuation.
Private Function IsJustGreySpace _
                 ( _
                            ByVal TheRange As Range _
                 ) _
        As Boolean

  Static rexJustWhiteSpaceExCrLfOrPunctuation As Object '## early binding:- As VBScript_RegExp_55.RegExp
  If rexJustWhiteSpaceExCrLfOrPunctuation Is Nothing Then
    Set rexJustWhiteSpaceExCrLfOrPunctuation = CreateObject("VBScript.RegExp") ' ## early binding:- = New VBScript_RegExp_55.RegExp
    rexJustWhiteSpaceExCrLfOrPunctuation.Pattern = "^(?![^\r\n]*?[\r\n].*$)[\s?!.,:;-]*$" ' ## the last * instead of + is a bug-workaround (Bug#2 - see end of main sub) ##
  End If

  IsJustGreySpace = rexJustWhiteSpaceExCrLfOrPunctuation.test(TheRange.Text)

End Function

Private Function NotJustGreySpace _
                 ( _
                            ByVal TheRange As Range _
                 ) _
        As Boolean

  NotJustGreySpace = Not IsJustGreySpace(TheRange)

End Function

Private Function TrimRange _
                 ( _
                            ByRef TheRange As Range _
                 ) _
        As Range

  Static rexTrim As Object '## early binding:- As VBScript_RegExp_55.RegExp
  If rexTrim Is Nothing Then
    Set rexTrim = CreateObject("VBScript.RegExp") ' ## early binding:- = New VBScript_RegExp_55.RegExp
    rexTrim.Pattern = "(^[\s?!.,:;-]*)(.*?)([\s?!.,:;-]*$)"
  End If

  With rexTrim.Execute(TheRange.Text)(0)
    If Len(.SubMatches(1)) = 0 _
    Then ' ~~ Grey-space Only ~~
      TheRange.Collapse wdCollapseEnd
    Else
      TheRange.SetRange TheRange.Start + Len(.SubMatches(0)), TheRange.End - Len(.SubMatches(2))
    End If
  End With
  Set TrimRange = TheRange

End Function

Критерии:

Я позволил себе немного расширить / экстраполировать критерии для преобразования пустого пространства. Они могут быть изменены, если они не соответствуют вашим точным требованиям. В настоящее время они являются:

1. Преобразование выполняется для каждого отдельного типа формата независимо, то есть жирным шрифтом, курсивом, подчеркиванием. В настоящее время скрипт обрабатывает только эти три типа. Типы могут быть легко добавлены / удалены.
2. Преобразование осуществляется на основе строки. Границы линий никогда не пересекаются. Это результат обработки символов возврата каретки и перевода строки как не пробелов и использования встроенного в Word поиска, завершающего поиск на границе строки.
3. Исходя из запроса в комментариях, знаки препинания ?!.,:;- теперь обрабатываются так же, как и пробел.
4. Любая последовательность последовательных пробелов / знаков препинания, в которой символ, не являющийся пробелами / знаками препинания, предшествующий последовательности, имеет такое же форматирование, что и символ, следующий за последовательностью, преобразуется в этот формат. Обратите внимание, что это приводит к удалению форматирования из пробела / пунктуации между неформатированными словами, а также к "расширению" форматированного текста для охвата неформатированного пробела / пунктуации.
5. Если предшествующий и последующий форматы символов последовательной последовательности пробелов / знаков пунктуации различаются, последовательность пробелов / знаков пунктуации принудительно не форматируется. В сочетании с конвертацией на строку это приводит к:
   1. Пробел / пунктуация в начале или в конце неформатированной строки;
   2. Пробел / пунктуация в начале или конце отформатированного текста.

Заметки:

• Сценарий довольно хорошо задокументирован, поэтому он должен быть понятен.

• Он использует позднюю привязку, поэтому нет необходимости устанавливать ссылки.

РЕДАКТИРОВАТЬ: Обновлено с новой версией в соответствии с комментариями.