Localizar e substituir "caractere curinga" do Word usa uma forma (muito) limitada e não padrão de expressões regulares. Juntamente com o fato de que você deseja encontrar e substituir formatos também, significa que não é possível fazer o que você deseja usando puramente usando o recurso de localizar e substituir, curingas ou não.
No entanto, é possível alavancar a localização / substituição do Word em uma macro para realizar a conversão inteligente de espaço em branco. Também é possível gravar uma macro usando apenas o regex adequado disponível para o VBA, sem acessar o localizar / substituir do Word.
A solução a seguir faz o primeiro e usa o objeto Find para executar / localizar programaticamente o Word sem usar curingas. No entanto, ele usa as expressões regulares do VBA (ou mais estritamente do VBScript) em algumas funções auxiliares para torná-las mais simples.
Em vez de converter apropriadamente o espaço em branco, que ainda exigiria localizar e substituir todas as etapas, o script converte efetivamente o espaço em branco e faz a quebra automática de HTML e a remoção de formato ao mesmo tempo.
'============================================================================================
' 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
Critérios:
Tomei a liberdade de expandir / extrapolar um pouco os critérios de conversão do espaço em branco. Eles podem ser modificados se não atenderem aos seus requisitos exatos. Atualmente eles são:
- A conversão é feita para cada tipo de formato individual independentemente, por exemplo, negrito, itálico e sublinhado. Atualmente, o script processa esses três tipos apenas. Tipos podem ser facilmente adicionados / removidos.
- A conversão é feita por linha. Limites de linha nunca são cruzados. Isso é um resultado do tratamento dos caracteres retorno de linha e alimentação de linha como não espaço em branco e aproveitando a localização do Word que encerra uma pesquisa em um limite de linha.
- Na sequência da solicitação nos comentários, os caracteres de pontuação
?!.,:;-agora são tratados da mesma forma que o espaço em branco. - Qualquer sequência de espaço em branco consecutivo / pontuação, em que o caractere não espaço em branco / pontuação que precede a sequência tem a mesma formatação do caractere após a sequência, é convertido nesse formato. Observe que isso resulta na remoção da formatação do espaço em branco / pontuação entre as palavras não formatadas, bem como na "expansão" do texto formatado para abranger o espaço em branco não formatado / pontuação.
- Se os formatos de caracteres precedentes e seguintes de uma seqüência consecutiva de espaço em branco / pontuação forem diferentes, a seqüência de espaço em branco / pontuação não será formatada forçadamente. Combinado com conversão por linha, isso resulta em:
- Espaço em branco / pontuação no início ou no final de uma linha não formatada;
- Espaço em branco / pontuação no início ou no final de uma seção do texto formatado não formatado.
Notas:
-
O roteiro é bastante bem documentado, então deve ser auto-explicativo.
-
Ele usa ligação tardia, portanto, nenhuma referência precisa ser definida.
EDITAR: Atualizado com nova versão conforme comentários.