Інтелектуально змінивши форматування пробілів у відповідності з суміжним форматуванням?

Microsoft Word надає можливість пошуку відформатованого тексту та його заміни та форматування. Ця особливість чудова в моїй роботі, де мені доводиться перетворювати документи Word в огляди в Інтернеті. Простим прикладом може бути пошук boldслова та його заміна <strong>bold</strong>.

Однак бувають випадки, коли документ, який ми отримуємо, має сторонні, неформатовані проміжки між зазначеним форматуванням. Це робить процес пошуку та заміни всього жирного тексту трохи складнішим. Також бувають випадки, коли у форматі білого простору застосовується форматування, коли воно не повинно.

Що таке пошук / заміна макросу або символів підстановки (регулярного вираження), щоб знайти та замінити весь пробіл з неправильним форматуванням з правильно відформатованим пробілом?

Два критерії "неправильно" - це те, що останній пробіл у рядку повинен бути неформатованим, а пробіл між двома словами відформатований повинен бути відформатований. По суті, я намагаюся створити найчистіший Замінити все можливе.

Візьмемо наступний знімок екрана:

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

Червона / помаранчева підсвітка являє собою пробіл, виділений жирним шрифтом, але має бути нормальним, нежирним стилем.

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

Для подальшого пояснення:

В даний час, якщо я знаходжу і замінюю все лише за допомогою використання формату стилю шрифту 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%

(Зверніть увагу, що я використовую курсив і жирний шрифт як приклади, але те саме можна сказати і для підкреслення тексту.)

"Підстановочна карта" Word знайде та замінить використовує (дуже) обмежену, нестандартну форму регулярних виразів. У поєднанні з тим, що ви хочете знайти і замінити формати, це означає, що неможливо робити те, що вам потрібно, лише використовуючи вбудований пошук і заміну, макіяж чи ні.

Тим НЕ менше, це можна використовувати знахідку в Word / замінити в макрос для виконання інтелектуального перетворення білого простору. Можна також написати макрос, використовуючи лише відповідний регулярний вираз, доступний для VBA, без доступу до пошуку / заміни Word.

Наведене нижче рішення виконує перше і використовує Findоб'єкт для програмного виконання пошуку / заміни Word, не використовуючи підстановки. Однак він використовує (або більш строго 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. Пробіл / пунктуація на початку або в кінці розділу форматованого тексту, що неформатований.

Примітки:

• Сценарій досить добре задокументований, тому він повинен бути пояснювальним.

• Він використовує пізнє прив'язування, тому не потрібно встановлювати посилання.

EDIT: Оновлено новою версією згідно коментарів.