Erste Platzhalter in Fund zu arbeiten und Ersetzen-Funktion in VBA-Makro für Microsoft Word

Question

Ich habe einen VBA-Makro für Microsoft Word, die mich zu verbessern versuchen.

Der Zweck des Makros ist zu fett und alle Worte in einem Dokument italicize, die die Suchbegriffe in der ersten Tabelle des Dokuments entsprechen.

Das Problem ist, die Suchbegriffe Platzhalter enthalten, die die folgenden:

der Bindestrich „-“: zwischen den Buchstaben ein Platzhalter für entweder einen Raum oder einen Zeitraum

Stern „&“: (die Website ist nicht dass ich in Sternchen setzen, da dies der Abschlag für Kursiv ist, also werde ich stattdessen das Symbol & setzen in um die Filter zu bekommen) eine Wildcard für eine beliebige Anzahl von Zeichen an der Anfang eines Wortes oder an dem Ende. Im Gegensatz zu normalen Programmiersprachen aber, wenn es in der Mitte des Wortes verwendet wird, muss es mit dem Bindestrich sein, um ein Platzhalter für eine Reihe von Zeichen kombiniert werden. Zum Beispiel "th & -en" würde abholen "dort", während "th & e" würde nicht.

Fragezeichen "?": Platzhalter für ein einzelnes Zeichen

Was ich bisher zu tun testet nur für diese Zeichen und wenn sie sie vorhanden sind, im Fall des Sternchens ich entweder abreißen, oder ich den Benutzer warnen, dass sie manuell für das Wort zu suchen. Nicht ideal :-P

Ich habe die .MatchWildcard Eigenschaft in VBA versucht, aber es noch nicht bekommen zu arbeiten. Ich habe das Gefühl, es hat etwas mit dem zu ersetzenden Text, nicht der Suchtext zu tun.

Eine Arbeits Makro wird, um die folgenden als seine Eingabe (die erste Zeile absichtlich ignoriert wird, und die zweite Spalte ist die mit der Zielsuchworte):

Stellen Sie sich in einer Tabelle alle in der zweiten Spalte (wie der HTML erlaubt hier nicht tr ermöglichen und td usw.)

  

Erste Reihe: Wort
  Zweite Reihe: Stellensuche   Dritte Reihe: & earch1
  Vierte Reihe: Search2 &
  Fünfte Reihe: S-earch3
  Sechste Reihe: S arch4
  Siebte Reihe: S & -ch5

Und es wird das Dokument suchen und ersetzen mit fett und kursiv gedruckten Inhalt wie folgt:

Suche Search1 Search2 Search3 Suche 4 SEARCH5

Hinweis: Search3 auch S.earch3 abholen könnte und ersetzen mit Search3

Wie könnte man die Suchbegriffe annehmen wird in der Regel nicht richtig sein, nebeneinander -. Das Makro sollte alle Instanzen finden

Ich werde meinen versucht, aber nicht funktionsfähig Code als auch nach dem ersten Arbeits Makro enthalten.

Der Code für das Arbeits Makro auf Pastebin für einen Monat von heute sein wird, die 9/17/09 ist, unter dem folgenden:

War es hilfreich?

einreichen

Lösung 2

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 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

Vielleicht ist die LIKE-Anweisung könnte Ihnen helfen:

if "My House" like "* House" then

end if

Reguläre Ausdrücke: Die Suche nach Suche 4 und ersetzen Sie es durch Suche 4 und mit Wildcards, das zu erreichen:

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

Weitere Informationen, wie diese Platzhalter können verwendet werden gefunden werden hier Es könnte am Anfang schwierig sein, aber ich verspreche, Sie lieben es;)

Sie können Gebrauch ersetzen für Strings suchen auch:

Dim Text As String text = "Hallo Suche 4 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

Das Ergebnis für den variablen Text sei:

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

Also in Ihrem Code würden Sie verwenden

rngTable.Text as text

und

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

wäre der Bereich, den Sie möchten, fett setzen.