Obtention de caractères génériques pour travailler dans la fonction Rechercher et remplacer dans la macro VBA pour Microsoft Word

Question

J'ai une macro VBA pour Microsoft Word que j'essaie d'améliorer.

Le but de la macro est de mettre en gras et de mettre en italique tous les mots d'un document qui correspondent aux termes recherchés dans la première table du document.

Le problème est les termes de recherche comprennent des jokers qui sont les suivants:

le trait d'union « - »: entre les lettres d'un caractère générique pour un espace ou une période

astérisque « & »: (le site ne me laisse pas mettre des astérisques car c'est la marque d'italique, donc je mettrai à la place le symbole & pour contourner les filtres) un caractère générique pour n'importe quel nombre de caractères au début d'un mot ou à la fin. Contrairement aux langages de programmation normaux, quand il est utilisé au milieu du mot, il doit être combiné avec le trait d'union pour être un caractère générique pour une gamme de caractères. Par exemple "th & -e" ramasserait "là" alors que "th & e" ne le ferait pas.

point d'interrogation « ? »: Caractère générique pour un seul caractère

Ce que je fais à ce jour teste juste pour ces personnages et s'ils sont présents soit je les élaguer dans le cas de l'astérisque, ou je alerter l'utilisateur qu'il doit rechercher le mot manuellement. Pas idéal :-P

J'ai essayé la propriété .MatchWildcard dans VBA mais je ne l'ai pas encore fait fonctionner. J'ai le sentiment que cela a quelque chose à voir avec le texte de remplacement, pas le texte de recherche.

Une macro de travail prendra les éléments suivants en entrée (la première ligne est volontairement ignorée et la deuxième colonne est celle avec les termes de recherche cible):

Imaginez une table tous dans la deuxième colonne (comme html permis ici ne permet pas tr et td etc)

Première rangée: Mot
Deuxième rangée: Recherche
Troisième rangée: & earch1
quatrième rangée: Search2 &
Cinquième ligne: S-earch3
Sixième ligne: S? Arch4
Septième ligne: S & -ch5

Et il recherchera le document et le remplacer par le contenu gras et en italique comme ceci:

Recherche Search1 Search2 Search3 Search4 SEARCH5

note: Search3 pourrait également ramasser S.earch 3 et le remplacer par Search3

Comme on pourrait le supposer, les termes de recherche ne seront généralement pas les uns à côté des autres - la macro devrait trouver toutes les instances.

Je vais inclure mon code essayé mais non fonctionnel après la première macro de travail.

Le code de la macro de travail sera sur pastebin pendant un mois à compter d'aujourd'hui, soit le 17/09/09, au url suivant.

Merci encore pour vos idées et l'aide que vous pourriez avoir à offrir!

Sara

de travail VBA Macro:

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 

macro VBA Tentative Dysfonctionnement:

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

Peut-être que l'instruction LIKE pourrait vous aider:

if "My House" like "* House" then 

end if 

Expres réguliers sions: Recherche de Search4 et de le remplacer par SEARCH4 et en utilisant des caractères génériques pour y parvenir:

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 

Plus d'informations comment ces jokers à utiliser peuvent être trouvés here Il pourrait être difficile au début, mais je vous promets que vous allez adorer elle;)

Vous pouvez remplacer utiliser pour rechercher des chaînes aussi:

texte Dim As String text = "Bonjour Search4 search3 sAarch2 search0 Recherche"

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 

Le résultat pour le texte variable serait:

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

Donc, dans votre code que vous utiliseriez

rngTable.Text as text 

et

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

serait la plage que vous voulez mettre en gras.