Hacer que los comodines funcionen en la función buscar y reemplazar en la macro VBA para Microsoft Word

Question

Tengo una macro VBA para Microsoft Word que estoy tratando de mejorar.

El propósito de la macro es poner en negrita y cursiva todas las palabras en un documento que coincidan con los términos de búsqueda en la primera tabla del documento.

El problema es que los términos de búsqueda incluyen comodines que son los siguientes:

el guión " - " ;: entre letras un comodín para un espacio o un punto

asterisco " & amp; " ;: (el sitio no me permite poner asteriscos ya que esta es la marca de descuento para cursiva, así que pondré el símbolo & amp; en su lugar para evitar los filtros) un comodín para cualquier Número de caracteres al principio de una palabra o al final. Sin embargo, a diferencia de los lenguajes de programación normales, cuando se usa en el medio de la palabra, debe combinarse con el guión para ser un comodín para un rango de caracteres. Por ejemplo '' th & amp; -e '' recogería " allí " mientras que & amp; e & amp; no lo haría.

signo de interrogación "? " ;: comodín para un solo carácter

Lo que estoy haciendo hasta ahora es solo probar estos caracteres y, si están presentes, los elimino en el caso del asterisco o alerto al usuario de que tienen que buscar la palabra manualmente. No es ideal :-P

He probado la propiedad .MatchWildcard en VBA pero aún no la he puesto a funcionar. Tengo la sensación de que tiene algo que ver con el texto de reemplazo, no con el texto de búsqueda.

Una macro de trabajo tomará lo siguiente como su entrada (la primera fila se ignora intencionalmente y la segunda columna es la que tiene los términos de búsqueda de destino):

Imagine esto en una tabla en la segunda columna (ya que el html permitido aquí no permite tr y td, etc.)

  

Primera fila: Word
  Segunda fila: Buscar
  Tercera fila: & amp; earch1
  Cuarta fila: Search2 & amp;
  Quinta fila: S-earch3
  Sexta fila: S? Arch4
  Séptima fila: S & amp; -ch5

Y buscará en el documento y lo reemplazará con contenido en negrita y cursiva como este:

Buscar Buscar1 Buscar2 Buscar3 Buscar4 Buscar5

Nota: S-earch3 también podría recoger S.earch3 y reemplazar con Search3

Como uno podría suponer que los términos de búsqueda generalmente no estarán uno al lado del otro, la macro debería encontrar todas las instancias.

Incluiré mi código intentado pero no funcional también después de la primera macro de trabajo.

El código para la macro de trabajo estará en pastebin durante un mes a partir de hoy, que es el 17/09/09, en el siguiente url .

¡Gracias de nuevo por cualquier pensamiento y ayuda que pueda ofrecer!

Sara

Macro VBA de trabajo:

Sub AllBold()

Dim tblOne As Table

Dim celTable As Cell

Dim rngTable As Range

Dim intCount As Integer

Dim celColl As Cells

Dim i As Integer

Dim rngLen As Integer

Dim bolWild As Boolean

Dim strWild As String


Set tblOne = ActiveDocument.Tables(1)

intCount = tblOne.Columns(2).Cells.Count

Set celColl = tblOne.Columns(2).Cells

strWild = ""

For i = 1 To intCount

    If i = 1 Then

    i = i + 1

    End If

    Set celTable = ActiveDocument.Tables(1).Cell(Row:=i, Column:=2)

    Set rngTable = ActiveDocument.Range(Start:=celTable.Range.Start, _
        End:=celTable.Range.End - 1)

    rngLen = Len(rngTable.Text)

    bolWild = False

    If (Mid(rngTable.Text, rngLen, 1) = "&") Then 'remember to replace & with asterisk!'

    rngTable.SetRange Start:=rngTable.Start, End:=rngTable.End - 1

    End If

    If (Mid(rngTable.Text, 1, 1) = "&") Then 'remember to replace & with asterisk!'

    rngTable.SetRange Start:=rngTable.Start + 1, End:=rngTable.End

    End If

    If InStr(1, rngTable.Text, "-", vbTextCompare) > 0 Then

    strWild = strWild + rngTable.Text + Chr$(13)

    bolWild = True

    End If

    If InStr(1, rngTable.Text, "?", vbTextCompare) > 0 Then

    strWild = strWild + rngTable.Text + Chr$(13)

    bolWild = True

    End If

    If (bolWild = False) Then

        Dim oRng As Word.Range

            Set oRng = ActiveDocument.Range

            With oRng.Find

            .ClearFormatting

            .Text = rngTable.Text

            With .Replacement

            .Text = rngTable.Text

            .Font.Bold = True

            .Font.Italic = True

            End With

            .Execute Replace:=wdReplaceAll

    End With

    End If

Next

If bolWild = True Then

MsgBox ("Please search the following strings with - or ? manually:" + Chr$(13) + strWild)

End If

End Sub

Intento de macro VBA no funcional:

Sub AllBoldWildcard()

Dim tblOne As Table

Dim celTable As Cell

Dim rngTable As Range

Dim intCount As Integer

Dim celColl As Cells

Dim i As Integer

Dim rngLen As Integer

Dim bolWild As Boolean

Dim strWild As String

Dim strWildcard As String


Set tblOne = ActiveDocument.Tables(1)

intCount = tblOne.Columns(2).Cells.Count

Set celColl = tblOne.Columns(2).Cells

strWild = ""

For i = 1 To intCount

    If i = 1 Then

    i = i + 1

    End If

    Set celTable = ActiveDocument.Tables(1).Cell(Row:=i, Column:=2)

    Set rngTable = ActiveDocument.Range(Start:=celTable.Range.Start, _
        End:=celTable.Range.End - 1)

    rngLen = Len(rngTable.Text)

    bolWild = False

    If (Mid(rngTable.Text, 1, 1) = "&") Then 'remember to replace & with asterisk!'

    rngTable.SetRange Start:=rngTable.Start + 1, End:=rngTable.End

    End If

    If InStr(1, rngTable.Text, "&", vbTextCompare) > 0 Then 'remember to replace & with asterisk!'

    strWildcard = rngTable.Text

    rngTable.Text = Replace(rngTable.Text, "&", "", 1) 'remember to replace & with asterisk!'

    bolWild = True

    End If

    If InStr(1, rngTable.Text, "-", vbTextCompare) > 0 Then

    strWildcard = Replace(rngTable.Text, "-", "[.-]", 1)

    bolWild = True

    End If

    If InStr(1, rngTable.Text, "?", vbTextCompare) > 0 Then

    strWild = strWild + rngTable.Text + Chr$(13)

    strWildcard = Replace(rngTable.Text, "?", "_", 1)


    bolWild = True

    End If

    If (bolWild = False) Then

        Dim oRng As Word.Range

            Set oRng = ActiveDocument.Range

            With oRng.Find

            .ClearFormatting

            .Text = strWildcard

            .MatchAllWordForms = False

            .MatchSoundsLike = False

            .MatchFuzzy = False

            .MatchWildcards = True


            With .Replacement

            .Text = rngTable.Text

            .Font.Bold = True

            .Font.Italic = True

            End With

            .Execute Replace:=wdReplaceAll

    End With

    End If

Next

'    If bolWild = True Then'

'    MsgBox ("Please search the following strings with - or ? manually:" + Chr$(13) + strWild)'

'    End If'

End Sub

Answer 1

Sub AllBold()

Dim tblOne As Table
Dim celTable As Cell
Dim rngTable As Range
Dim intCount As Integer
Dim intMatch As Integer
Dim celColl As Cells
Dim i As Integer
Dim strRegex As String
Dim Match, Matches

Set tblOne = ActiveDocument.Tables(1)
intCount = tblOne.Columns(2).Cells.Count
Set celColl = tblOne.Columns(2).Cells
Set objRegEx = CreateObject("vbscript.regexp")
objRegEx.Global = True
objRegEx.IgnoreCase = True
objRegEx.MultiLine = True

For i = 1 To intCount
    If i = 1 Then
        i = i + 1
    End If

    Set celTable = ActiveDocument.Tables(1).Cell(Row:=i, Column:=2)
    Set rngTable = ActiveDocument.Range(Start:=celTable.Range.Start, _
                                        End:=celTable.Range.End - 1)

    If rngTable.Text <> "" Then
        strRegex = rngTable.Text
        strRegex = Replace(strRegex, "*-", "[\w]{0,}[^\w]{0,1}[\w]{0,}", 1)
        strRegex = Replace(strRegex, "*", "\w+", 1)
        strRegex = Replace(strRegex, "-", "[^\w]{0,1}", 1)
        strRegex = Replace(strRegex, "?", ".", 1)
        objRegEx.Pattern = "\b" + strRegex + "\b"

        Dim oRng As Word.Range
        Set oRng = ActiveDocument.Range
        Set Matches = objRegEx.Execute(ActiveDocument.Range.Text)

        intMatch = Matches.Count
        If intMatch >= 1 Then
            rngTable.Bold = True
            For Each Match In Matches
                With oRng.Find
                    .ClearFormatting
                    .Text = Match.Value
                    With .Replacement
                        .Text = Match.Value
                        .Font.Bold = True
                        .Font.Italic = True
                    End With

                    .Execute Replace:=wdReplaceAll
                End With
            Next Match
        End If
    End If
Next i

End Sub

Answer 2

Tal vez la declaración LIKE podría ayudarlo:

if "My House" like "* House" then

end if

Expresiones regulares: Buscar Search4 y reemplazarlo por SEARCH4 y usar comodines para lograr eso:

Set objRegEx = CreateObject("vbscript.regexp")
objRegEx.Global = True
objRegEx.IgnoreCase = True
objRegEx.MultiLine = True 

'here you can enter your search with wild cards
'mine says "S" followed by any character followed by "arch" followed by 1-n numbers.
objRegEx.Pattern = "S.arch([0-9]+)"


newText = objRegEx.Replace("Test Search4", "SEARCH$1")
MsgBox (newText) 
'gives you: Test SEARCH4

Puede encontrar más información sobre cómo usar esos comodines aquí Puede ser difícil al principio, pero prometo que te encantará;)

También puede reemplazar el uso para buscar cadenas:

Dim texto como cadena text = " Hola Search4 search3 sAarch2 search0 search "

Set objRegEx = CreateObject("vbscript.regexp")
objRegEx.Global = True
objRegEx.IgnoreCase = True
objRegEx.MultiLine = True

'here you can enter your search with wild cards
'mine says "S" followed by any character followed by "arch" followed by 1-n numbers.
objRegEx.Pattern = "S.arch[0-9]+"


If (objRegEx.test(text) = True) Then
    Dim objMatch As Variant
    Set objMatch = objRegEx.Execute(text)   ' Execute search.

    Dim wordStart As Long
    Dim wordEnd As Long
    Dim intIndex As Integer
    For intIndex = 0 To objMatch.Count - 1
        wordStart = objMatch(intIndex).FirstIndex
        wordEnd = wordStart + Len(objMatch(intIndex))

        MsgBox ("found " & objMatch(intIndex) & " position: " & wordStart & " - " & wordEnd)
    Next
End If

El resultado para el texto variable sería:

Search4 position: 6 - 13
Search3 position: 14- 21
...

Entonces, en su código usaría

rngTable.Text as text

y

rngTable.SetRange Start:=rngTable.Start + wordStart, End:=rngTable.Start + wordEnd

sería el rango que desea poner en negrita.