 |
 | Home | Contact Us | FAQ | Search & Site Map | Link to Us |
 | Sign In | Join | Other 45 Sites in Network |
| HomeDiscussionsAccessExcelInfoPathOutlookPowerPointPublisherWordDirectoryUser Groups Related Topics Outlook ExpressInternet ExplorerWindowsMS Server ProductsMore Topics ... |
MS Office Forum / Word / Programming / December 2005word macro to hightlight text
Hi All, I use this macro in Word to hightlight certain words. Now I want to use wildcards but it's not possible with the code that I have because it will replace everything with the wildcards. Example: this code searches a txt file with the words to look for. If in the txt file I place the word: Ira? the code will scan my document and replace words like Iraq and Iran with Ira?. So what I want is that it leaves the word as it is and just highlights it. Sub ColorWords(ByVal strText As String, _ ByVal MyColor As Variant) With ActiveDocument.Content.Find .ClearFormatting .MatchWholeWord = True With .Replacement .ClearFormatting .Font.Color = MyColor .Highlight = True 'highlight the text in yellow End With .Execute FindText:=strText, ReplaceWith:=strText, _ Format:=True, Replace:=wdReplaceAll End With End Sub Regards Marco You need to use a proper Wildcard search (as distinct from a search using a wildcard) in which to search for Iraq or Iran or Iraqi or Iaranian, you would search for Ira[a-z]{1,} See the article "Finding and replacing characters using wildcards" at: http://www.word.mvps.org/FAQs/General/UsingWildcards.htm  SignatureHope this helps. Please reply to the newsgroup unless you wish to avail yourself of my services on a paid consulting basis. Doug Robbins - Word MVP > Hi All, > [quoted text clipped - 30 lines] > Regards > Marco Hi Marco, as Doug said, you need a wildcard search. There is no "matchwildcards" in your code. As to replacements and highlighting, I thought I knew how to do it, but couldn't get it to work. Maybe it's a matter of style, maybe I am used to some methods, and forget about alternatives. This is the way I'd do it: Sub ColorWords(sTmp As String, lFnt As Long, lHgh As Long) ' sTmp = a temporary string ' lFnt = the color of the font ' lHgh = the highlightcolor Dim rDcm As Range Set rDcm = ActiveDocument.Range With rDcm.Find .Text = sTmp .MatchWildcards = True While .Execute rDcm.Font.Color = lFnt rDcm.HighlightColorIndex = lHgh Wend End With End Sub Sub test8912() ColorWords "Ira[a-z]{1,}", wdColorRed, wdYellow End Sub SignatureGreetings from Bavaria, Germany Helmut Weber, MVP WordVBA Win XP, Office 2003 "red.sys" & Chr$(64) & "t-online.de" Helmut, frohe weihnachten.... I tried your code but I get an error 5560 on the string to search on. "Ira[a-z]{1,}" This is what I did: I tried both your version and the Ira* in my text file but the same error. Why is this not working? Sub GetStartedColoring() Dim strMyDocuments Dim arrKeyWords As Variant Dim arrSplit As Variant Dim i As Long Set objFSO = CreateObject("Scripting.FileSystemObject") Set objShell = CreateObject("WScript.Shell") strMyDocuments = objShell.SpecialFolders("MyDocuments") If Right(strMyDocuments, 1) <> "\" Then strMyDocuments = strMyDocuments & "\" End If If objFSO.FileExists(strMyDocuments & "ColorKeyWords.txt") Then arrKeyWords = InitFile(strMyDocuments & _ "ColorKeyWords.txt", ";") For i = 0 To UBound(arrKeyWords) If arrKeyWords(i) <> "" Then arrSplit = SplitIt(arrKeyWords(i), "=") HexValue = ConstConversion(Trim(arrSplit(1))) ColorWords Trim(arrSplit(0)), wdColorBlack, wdYellow End If Next i Selection.HomeKey Unit:=wdStory, Extend:=False Else MsgBox "Could not find " & _ strMyDocuments & "ColorKeyWords.txt . Exiting Macro." End If End Sub Function SplitIt(ByVal strIn As Variant, _ Optional ByVal strDelim As String = " ", _ Optional ByVal lCount As Long = -1) _ As Variant Dim vOut() As Variant Dim strSubString As String Dim k As Integer Dim lDelimPos As Long k = 0 lDelimPos = InStr(strIn, strDelim) Do While (lDelimPos) ' Get everything to the left of the delimiter strSubString = Left(strIn, lDelimPos - 1) ' Make the return array one element larger ReDim Preserve vOut(k) ' Add the new element vOut(k) = strSubString k = k + 1 If lCount <> -1 And k = lCount Then SplitIt = vOut Exit Function End If ' Only interested in what's right of delimiter strIn = Right(strIn, (Len(strIn) - _ (lDelimPos + Len(strDelim) - 1))) ' See if delimiter occurs again lDelimPos = InStr(strIn, strDelim) Loop ' No more delimiters in string. ' Add what's left as last element ReDim Preserve vOut(k) vOut(k) = strIn SplitIt = vOut End Function '=================================================== Function InitFile(HostSource, strComment) '******************************************************** 'Constants for file operations '* '******************************************************** Const ForReading = 1, ForWriting = 2, ForAppending = 8 '* '******************************************************** Dim ts Dim tsLine Dim arrWords As Variant Dim strTrim As String On Error Resume Next ReDim arrWords(0) Set ts = objFSO.OpenTextFile(HostSource, ForReading, False) Do While Not ts.AtEndOfStream tsLine = Trim(ts.ReadLine) tsLine = tsLine If tsLine <> "" And Left(tsLine, 1) <> strComment Then strTrim = Trim(tsLine) lngBoundary = UBound(arrWords) If arrWords(lngBoundary) = "" Then arrWords(lngBoundary) = strTrim Else ReDim Preserve arrWords(lngBoundary + 1) arrWords(lngBoundary + 1) = strTrim End If End If Loop ts.Close InitFile = arrWords On Error GoTo 0 End Function Function ConstConversion(ByVal strColor As String) Select Case strColor Case "wdColorAqua" ConstConversion = &HCCCC33 Case "wdColorAutomatic" ConstConversion = &HFF000000 Case "wdColorBlack" ConstConversion = 0 Case "wdColorBlue" ConstConversion = &HFF0000 Case "wdColorBlueGray" ConstConversion = &H996666 Case "wdColorBrightGreen" ConstConversion = 65280 Case "wdColorBrown" ConstConversion = &H3399 Case "wdColorDarkBlue" ConstConversion = &H800000 Case "wdColorDarkGreen" ConstConversion = &H3300 Case "wdColorDarkRed" ConstConversion = &H80 Case "wdColorDarkTeal" ConstConversion = &H663300 Case "wdColorDarkYellow" ConstConversion = 32896 Case "wdColorGold" ConstConversion = 52479 Case "wdColorGray05" ConstConversion = &HF3F3F3 Case "wdColorGray10" ConstConversion = &HE6E6E6 Case "wdColorGray125" ConstConversion = &HE0E0E0 Case "wdColorGray15" ConstConversion = &HD9D9D9 Case "wdColorGray20" ConstConversion = &HCCCCCC Case "wdColorGray25" ConstConversion = &HC0C0C0 Case "wdColorGray30" ConstConversion = &HB3B3B3 Case "wdColorGray35" ConstConversion = &HA6A6A6 Case "wdColorGray375" ConstConversion = &HA0A0A0 Case "wdColorGray40" ConstConversion = &H999999 Case "wdColorGray45" ConstConversion = &H8C8C8C Case "wdColorGray50" ConstConversion = &H808080 Case "wdColorGray55" ConstConversion = &H737373 Case "wdColorGray60" ConstConversion = &H666666 Case "wdColorGray625" ConstConversion = &H606060 Case "wdColorGray65" ConstConversion = &H656565 Case "wdColorGray70" ConstConversion = &H4C4C4C Case "wdColorGray75" ConstConversion = &H404040 Case "wdColorGray80" ConstConversion = &H333333 Case "wdColorGray85" ConstConversion = &H262626 Case "wdColorGray875" ConstConversion = &H202020 Case "wdColorGray90" ConstConversion = &H191919 Case "wdColorGray95" ConstConversion = 789516 Case "wdColorGreen" ConstConversion = 32768 Case "wdColorIndigo" ConstConversion = &H993333 Case "wdColorLavender" ConstConversion = &HFF99CC Case "wdColorLightBlue" ConstConversion = &HFF6633 Case "wdColorLightGreen" ConstConversion = &HCCFFCC Case "wdColorLightOrange" ConstConversion = 39423 Case "wdColorLightTurquoise" ConstConversion = &HFFFFCC Case "wdColorLightYellow" ConstConversion = &H99FFFF Case "wdColorLime" ConstConversion = 52377 Case "wdColorOliveGreen" ConstConversion = 13107 Case "wdColorOrange" ConstConversion = 26367 Case "wdColorPaleBlue" ConstConversion = &HFFCC99 Case "wdColorPink" ConstConversion = &HFF00FF Case "wdColorPlum" ConstConversion = 6697881 Case "wdColorRed" ConstConversion = 255 Case "wdColorRose" ConstConversion = &HCC99FF Case "wdColorSeaGreen" ConstConversion = &H669933 Case "wdColorSkyBlue" ConstConversion = &HFFCC00 Case "wdColorTan" ConstConversion = &H99CCFF Case "wdColorTeal" ConstConversion = &H808000 Case "wdColorTurquoise" ConstConversion = &HFFFF00 Case "wdColorViolet" ConstConversion = &H800080 Case "wdColorWhite" ConstConversion = &HFFFFFF Case "wdColorYellow" ConstConversion = 65535 Case Else ConstConversion = 0 End Select End Function Sub ColorWords(sTmp As String, lFnt As Long, lHgh As Long) ' sTmp = a temporary string ' lFnt = the color of the font ' lHgh = the highlightcolor Dim rDcm As Range Set rDcm = ActiveDocument.Range With rDcm.Find .Text = sTmp .MatchWildcards = True While .Execute rDcm.Font.Color = lFnt rDcm.HighlightColorIndex = lHgh Wend End With End Sub And in a text file I put this: Ira[a-z]{1,}=wdColorDarkYellow ;Valid color keywords ;wdColorAqua = &HCCCC33 ;wdColorAutomatic = &HFF000000 ;wdColorBlack = 0 ;wdColorBlue=&HFF0000 ;wdColorBlueGray = &H996666 ;wdColorBrightGreen = &HFF00 ;wdColorBrown = &H3399 ;wdColorDarkBlue = &H800000 ;wdColorDarkGreen = &H3300 ;wdColorDarkRed = &H80 ;wdColorDarkTeal = &H663300 ;wdColorDarkYellow = &H8080 ;wdColorGold = &HCCFF ;wdColorGray05 = &HF3F3F3 ;wdColorGray10 = &HE6E6E6 ;wdColorGray125 = &HE0E0E0 ;wdColorGray15 = &HD9D9D9 ;wdColorGray20 = &HCCCCCC ;wdColorGray25 = &HC0C0C0 ;wdColorGray30 = &HB3B3B3 ;wdColorGray35 = &HA6A6A6 ;wdColorGray375 = &HA0A0A0 ;wdColorGray40 = &H999999 ;wdColorGray45 = &H8C8C8C ;wdColorGray50 = &H808080 ;wdColorGray55 = &H737373 ;wdColorGray60 = &H666666 ;wdColorGray625 = &H606060 ;wdColorGray65 = &H656565 ;wdColorGray70 = &H4C4C4C ;wdColorGray75 = &H404040 ;wdColorGray80 = &H333333 ;wdColorGray85 = &H262626 ;wdColorGray875 = &H202020 ;wdColorGray90 = &H191919 ;wdColorGray95 = &HC0C0C ;wdColorGreen = &H8000 ;wdColorIndigo = &H993333 ;wdColorLavender = &HFF99CC ;wdColorLightBlue = &HFF6633 ;wdColorLightGreen = &HCCFFCC ;wdColorLightOrange = &H99FF ;wdColorLightTurquoise = &HFFFFCC ;wdColorLightYellow = &H99FFFF ;wdColorLime = 52377 ;wdColorOliveGreen = &H3333 ;wdColorOrange = &H66FF ;wdColorPaleBlue = &HFFCC99 ;wdColorPink = &HFF00FF ;wdColorPlum = &H663399 ;wdColorRed = &HFF ;wdColorRose = &HCC99FF ;wdColorSeaGreen = &H669933 ;wdColorSkyBlue = &HFFCC00 ;wdColorTan = &H99CCFF ;wdColorTeal = &H808080 ;wdColorTurquoise = &HFFFF00 ;wdColorViolet = &H800080 ;wdColorWhite = &HFFFFFF ;wdColorYellow = &HFFFF Regards Marco The Netherlands The following modification of Helmut's code applies the colouring to all words in a document that match the wildcard search criteria e.g. Iran Iraq, Iranian, Iraqi Sub ColorWords(sTmp As String, lFnt As Long, lHgh As Long) ' sTmp = a temporary string ' lFnt = the color of the font ' lHgh = the highlightcolor Selection.HomeKey wdStory Selection.Find.ClearFormatting With Selection.Find Do While .Execute(FindText:=sTmp, MatchWildcards:=True, Wrap:=wdFindStop, Forward:=True) = True Selection.Range.Font.Color = lFnt Selection.Range.HighlightColorIndex = lHgh Selection.Collapse wdCollapseEnd Loop End With End Sub Sub test8912() ColorWords "Ira[a-z]{1,}", wdColorRed, wdYellow End Sub . SignatureHope this helps. Please reply to the newsgroup unless you wish to avail yourself of my services on a paid consulting basis. Doug Robbins - Word MVP > Helmut, > [quoted text clipped - 338 lines] > Marco > The Netherlands Hi Marco, the comma in the search pattern is a semikolon ";" in Germany, the Netherlands, and some other countries. I'm using a US-version. I did not look in the rest of the code. Frohe Weinhacht. SignatureGreetings from Bavaria, Germany Helmut Weber, MVP WordVBA Win XP, Office 2003 "red.sys" & Chr$(64) & "t-online.de" Helmut, It's working now with the searchstring: Ira[a-z]{1;}=wdColorDarkYellow But the code stops after it finds the first word Iran. I also tried the MatchWholeWord but that doesn't help. Do While .Execute(FindText:=sTmp, MatchWholeWord:=True, MatchWildcards:=True, Wrap:=wdFindStop, Forward:=True) = True Marco Hi Marco, that's really a lot of code, some of which doesn't make sense to me. Do you want to search the whole doc? Then there is no need for a selection object, no need for Wrap:=wdFindStop, no need for Forward:=True and all other parameters except matchwildcards, and the search string. Searching and highlighting Ira[a-z]{1;} works right here and now, (with a comma for me, of course). I can't see where the "=wdColorDarkYellow" comes in. Further more, this seems much too much code for me. "Hexvalue" doesn't to anything and is never declared. So even ConstConversion doesn't do anything, as the result as that function is never used either. Avoid "variant". A function should return something with a data type. Is it, that you want to set the highlightcolor of certain character patterns, defined in a text file? Then I'd usesomething like: I[a-z]{1,}=&H8080 F[a-z]{1,}=&H8080 L[a-z]{1,}=&H66FF Whether you use a string representing a number in hex-notation or binary or decimal doesn't matter. hmm... difficult, but I like it. SignatureGreetings from Bavaria, Germany Helmut Weber, MVP WordVBA Win XP, Office 2003 "red.sys" & Chr$(64) & "t-online.de" Helmut, Yes I want to search the whole doc. But not just on one thing. I want to be able to search on several strings. That's why I have this txt-file with all the words. [helmut wrote] I can't see where the "=wdColorDarkYellow" comes in. that's because most people do not know what something like &H8080 stands for. It is in the textfile and gets translated in the code to Hex. Is it, that you want to set the highlightcolor of certain character patterns, defined in a text file? [Helmut wrote] Then I'd usesomething like: I[a-z]{1,}=&H8080 F[a-z]{1,}=&H8080 L[a-z]{1,}=&H66FF Yes I do..... How would my code look like? Searching on multiple strings that I define in this textfile. Marco Helmut, I played around a bit and got things working. I skipped a lot of code and ended up with this: The only thing I have to learn is setting the wildcards. Can you explain me how the codes work? Ira[a-z]{1;} [a-z]tt[a-z]{1;} Can I use {1;) in front also and what does the number mean exactly? Can I use {10;} and what does it do? Public objFSO As Object Public objShell As Object Sub GetStartedColoring() Dim strMyDocuments Dim arrKeyWords As Variant Dim arrSplit As Variant Dim i As Long Set objFSO = CreateObject("Scripting.FileSystemObject") Set objShell = CreateObject("WScript.Shell") strMyDocuments = objShell.SpecialFolders("MyDocuments") If Right(strMyDocuments, 1) <> "\" Then strMyDocuments = strMyDocuments & "\" End If If objFSO.FileExists(strMyDocuments & "ColorKeyWords.txt") Then arrKeyWords = InitFile(strMyDocuments & _ "ColorKeyWords.txt", ";") For i = 0 To UBound(arrKeyWords) If arrKeyWords(i) <> "" Then ColorWords Trim(arrKeyWords(i)), wdColorBlack, wdYellow End If Next i Selection.HomeKey Unit:=wdStory, Extend:=False Else MsgBox "Could not find " & _ strMyDocuments & "ColorKeyWords.txt . Exiting Macro." End If End Sub Function InitFile(HostSource, strComment) 'Constants for file operations '* Const ForReading = 1, ForWriting = 2, ForAppending = 8 '* Dim ts Dim tsLine Dim arrWords As Variant Dim strTrim As String On Error Resume Next ReDim arrWords(0) Set ts = objFSO.OpenTextFile(HostSource, ForReading, False) Do While Not ts.AtEndOfStream tsLine = Trim(ts.ReadLine) tsLine = tsLine If tsLine <> "" And Left(tsLine, 1) <> strComment Then strTrim = Trim(tsLine) lngBoundary = UBound(arrWords) If arrWords(lngBoundary) = "" Then arrWords(lngBoundary) = strTrim Else ReDim Preserve arrWords(lngBoundary + 1) arrWords(lngBoundary + 1) = strTrim End If End If Loop ts.Close InitFile = arrWords On Error GoTo 0 End Function Sub ColorWords(sTmp As String, lFnt As Long, lHgh As Long) ' sTmp = a temporary string ' lFnt = the color of the font ' lHgh = the highlightcolor Dim rDcm As Range Set rDcm = ActiveDocument.Range With rDcm.Find .Text = sTmp .MatchWildcards = True While .Execute rDcm.Font.Color = lFnt rDcm.HighlightColorIndex = lHgh Wend End With End Sub Regards Marco The use of the wildcard search is all explained in the article "Finding and replacing characters using wildcards" at: http://www.word.mvps.org/FAQs/General/UsingWildcards.htm to which I referred you in my response to your initial post. [a-z]{1;} means one or more occurences of any letter in the range a to z [a-z]tt[a-z]{1;} is not a valid wildcard search string If you wanted to select words such as: attraction attention inattention you would use: [a-z]{1;}tt[a-z]{1;} SignatureHope this helps. Please reply to the newsgroup unless you wish to avail yourself of my services on a paid consulting basis. Doug Robbins - Word MVP > Helmut, > [quoted text clipped - 101 lines] > Regards > Marco Hello Doug, Thanks for the explanation. However your example of: [a-z]{1;}uze[a-z]{1;} doesn't return anything in my code. Only in this form: [a-z]uze[a-z]{1;} it will return for example :huzestan Can't seem to get the search for words with "uze" in the middle right. Marco Hi Marco try: [a-z]@uze[a-z]{1;} That seems to be one of the reasons, why some people mistrust wildcard searches. Hi Doug, hoping you don't mind adding my "2 cents worth", :-) an expression, I've learned recently. Is that common use in English? SignatureGreetings from Bavaria, Germany Helmut Weber, MVP WordVBA Win XP, Office 2003 "red.sys" & Chr$(64) & "t-online.de" Helmut, My word crashes over and over with this line. What does it do? Marco > Hi Marco > [quoted text clipped - 4 lines] > That seems to be one of the reasons, > why some people mistrust wildcard searches. Well, they distrust them because they are tricky beasts. Take Doug's expression [a-z]{1;}tt[a-z]{1;} {} tries to match as much as it can. So [a-z]{1;} would already match the whole of attraction attention inattention "tt" in the search expression, and the rest of the expression, never match anything, so the match fails. The following would have matched the three words: [a-su-z]{1;}tt[a-z]{1;} Regards, Klaus I am not sure why that doesn't work. I would have thought that it would. The following does however find huzestan [a-z]{1;1}uze[a-z]{1;} SignatureHope this helps. Please reply to the newsgroup unless you wish to avail yourself of my services on a paid consulting basis. Doug Robbins - Word MVP > Hello Doug, > [quoted text clipped - 12 lines] > > Marco Not with me it doesn't. Is it maybe the code I'm using that's calling this indifference? Sub ColorWords(sTmp As String, lFnt As Long, lHgh As Long) ' sTmp = a temporary string ' lFnt = the color of the font ' lHgh = the highlightcolor Dim rDcm As Range Set rDcm = ActiveDocument.Range With rDcm.Find .Text = sTmp .MatchWildcards = True While .Execute rDcm.Font.Color = lFnt rDcm.HighlightColorIndex = lHgh Wend End With End Sub Using the following modified version of the code that Helmut posted: Sub ColorWords(sTmp As String, lFnt As Long, lHgh As Long) ' sTmp = a temporary string ' lFnt = the color of the font ' lHgh = the highlightcolor Selection.HomeKey wdStory Selection.Find.ClearFormatting With Selection.Find Do While .Execute(FindText:=sTmp, MatchWildcards:=True, _ Wrap:=wdFindStop, Forward:=True) = True Selection.Range.Font.Color = lFnt Selection.Range.HighlightColorIndex = lHgh Selection.Collapse wdCollapseEnd Loop End With End Sub Sub test8912() ColorWords "[a-z]{1,1}uze[a-z]{1,}", wdColorRed, wdYellow End Sub each instance of the word huzestan that I inserted into a document had the colour of its font changed the red and a high-light colour of yellow applied. So I think that it may be something to do with the code. Interestingly though, using [a-z]{1,5}uze[a-z]{1,} which should find between 1 and 5 instances of any lower case letter before the uze does not find huzestan. It does however find abcdhuzestan and mnophuzestan (5 lower case letters before uze), but not abdhuzestan (4 lowercase letters before uze. I am not sure how many words there are with a variable number of lowercase letters before and after uze, but using: Sub ColorWords(sTmp As String, lFnt As Long, lHgh As Long) ' sTmp = a temporary string ' lFnt = the color of the font ' lHgh = the highlightcolor Dim colrange As Range Selection.HomeKey wdStory Selection.Find.ClearFormatting With Selection.Find Do While .Execute(FindText:=sTmp, MatchWildcards:=False, _ 'note MatchWildcards set to False Wrap:=wdFindStop, Forward:=True) = True Set colrange = Selection.Range.Words(1) colrange.Font.Color = lFnt colrange.HighlightColorIndex = lHgh Selection.Collapse wdCollapseEnd Loop End With End Sub Sub test8912() ColorWords "uze", wdColorRed, wdYellow End Sub will apply the colouring to anyword that contains uze. SignatureHope this helps. Please reply to the newsgroup unless you wish to avail yourself of my services on a paid consulting basis. Doug Robbins - Word MVP > Not with me it doesn't. > Is it maybe the code I'm using that's calling this indifference? [quoted text clipped - 17 lines] > > End Sub I tried both codes and I think I like the first one better. Although one can always choose to search with- or without Wildcards. I was wondering when you have a lot of words to search on. Can you give them different colours? For i = 0 To UBound(arrKeyWords) If arrKeyWords(i) <> "" Then ColorWords Trim(arrKeyWords(i)), wdColorBlack, wdYellow End If Next i So instead of saying wdYellow all the time for every different word have a random colour like Google does when I search the newsgroups? Marco Almost certainly, the answer is yes. I don't have the code for it at my fingertips though. You could have another array of colours and use the Rnd function to randomly grab a colour from the array. Here's a bit of the help file information on it: To produce random integers in a given range, use this formula: Int((upperbound - lowerbound + 1) * Rnd + lowerbound) Here, upperbound is the highest number in the range, and lowerbound is the lowest number in the range. SignatureHope this helps. Please reply to the newsgroup unless you wish to avail yourself of my services on a paid consulting basis. Doug Robbins - Word MVP >I tried both codes and I think I like the first one better. Although > one can always choose to search with- or without Wildcards. [quoted text clipped - 12 lines] > > Marco Hi Marco, >I was wondering when you have a lot of words to search on. Can you give >them different colours? [quoted text clipped - 4 lines] > End If > Next i For 3 alternating colors, like this: For i = 1 To 3 If i Mod 2 = 0 Then ' even numbers 'ColorWords Trim(arrKeyWords(i)), wdColorBlack, wdYellow MsgBox "Yellow" ElseIf i Mod 3 = 0 Then ' numbers that can be divided ' by 3 without remainder 'ColorWords Trim(arrKeyWords(i)), wdColorBlack, wdRed MsgBox "red" Else 'ColorWords Trim(arrKeyWords(i)), wdColorBlack, wdBlue MsgBox "blue" End If Next SignatureGreetings from Bavaria, Germany Helmut Weber, MVP WordVBA Win XP, Office 2003 "red.sys" & Chr$(64) & "t-online.de" How about an array: Sub GetStartedColoring() Dim strMyDocuments Dim arrKeyWords As Variant Dim arrSplit As Variant Dim i, j As Long Dim vColours As Variant vColours = Array(7, 3, 4, 6, 5, 10) 'yellow, turquoise, brightgreen, red, pink, teal Dim MyHightlightColour As Long Set objFSO = CreateObject("Scripting.FileSystemObject") Set objShell = CreateObject("WScript.Shell") strMyDocuments = objShell.SpecialFolders("MyDocuments") If Right(strMyDocuments, 1) <> "\" Then strMyDocuments = strMyDocuments & "\" End If If objFSO.FileExists(strMyDocuments & "ColorKeyWords.txt") Then arrKeyWords = InitFile(strMyDocuments & _ "ColorKeyWords.txt", ";") For i = 0 To UBound(arrKeyWords) If arrKeyWords(i) <> "" Then If j > 5 Then j = 1 MyHightlightColour = vColours(j) ColorWords Trim(arrKeyWords(i)), wdColorBlack, MyHightlightColour j = j + 1 End If Next i Selection.HomeKey Unit:=wdStory, Extend:=False Else MsgBox "Could not find " & _ strMyDocuments & "ColorKeyWords.txt . Exiting Macro." End If End Sub Greetings Marco Hi Marco, >How about an array: of course you my use an array, there are lots of possible ways. If your array is zero based, then however, yellow is used only once, IMHO. Inititialize your variables, that is, assign a value to them before the first use. And don't use variant. Sooner or later you'll run into trouble. If you have to setup a program again like the one we spoke about here, you may have a go at avoiding wildcards altogether. Which appraoch would be more suitable, depends on the task and on the data to be processed. SignatureGreetings from Bavaria, Germany Helmut Weber, MVP WordVBA Win XP, Office 2003 "red.sys" & Chr$(64) & "t-online.de" You mean I have to initialize this earlier: ? MyHightlightColour = vColours(j) You mean using Dim vColours As Long vColours = Array(7, 3, 4, 6, 5, 10) instead? And yes you are right about wildcards but what if I have docs with a lot of different spellings and still I want to find all these words. Then I would need a lot of entries. For example: kadafi kaddafi kadaffi kaddaffi khadafi khaddafi khadaffi khaddaffy etc.... How you wanna do that without wildcards? -- Marco Hi Marco, as far as I remember, "j" wasn't initialized. >You mean using Dim vColours As Long dim vColours(1 to 6) as long >And yes you are right about wildcards but what if I have docs with a >lot of different spellings and still I want to find all these words. >kadafi >kaddafi [quoted text clipped - 4 lines] >khadaffi >khaddaffy What do they have in common? Starting with "k", "daf" it seems somewhere later. Ending in "i" or "y". Pseudy code: dim oWrd as object For each oWrd in activedocument.words if oWrd.range.first = "k" and oWrd.range.last = i or oWrd.range.last = "y" and instr(oWrd, "daf") = 1 then ... next Lot's of tedious coding, but almost without bugs, and you have full control. In the end, wildcards do nothing but just this, it's only that you never can be sure, what they really do. You are searching for a string that is similar to another string. Google for Levenshtein or Levenstein distance. I have my own algorithm for calculating similarity. But that would mean 1000 code lines more. SignatureGreetings from Bavaria, Germany Helmut Weber, MVP WordVBA Win XP, Office 2003 "red.sys" & Chr$(64) & "t-online.de" Hi Marco, just to give you an idea of what you are trying, as it is so exiting for me. There is a set of strings: >kadafi >kaddafi [quoted text clipped - 5 lines] >khaddaffy >etc.... Excluding the etc., as it is complicated enough with a well definded set. What can you say about all(!) items in the set? All start with k. All contain k, a, d, and f. All contain daf. Never f before a. Never d before a. Never f before d. Are these all simple statements that can be made on all of the items? Whereby simply means "no counting", "no comparison", no "or", no "if". What can you say simply about some (more than 1) items in the set? Whereby simply means "no counting", "no comparison", no "or", no "if". Some contain kh. Some contain ffi. Some contain add... Ad nauseam... The end of all wildcard searches, but opening the doors to neurolinguistics... SignatureGreetings from Bavaria, Germany Helmut Weber, MVP WordVBA Win XP, Office 2003 "red.sys" & Chr$(64) & "t-online.de" Hi Marco >I played around a bit and got things working. Fine :-) >The only thing I have to learn is setting the wildcards. >Can you explain me how the codes work? > >Ira[a-z]{1;} >[a-z]tt[a-z]{1;} >Can I use {1;) in front also No. >and what does the number mean exactly? >Can I use {10;} and what does it do? If the listseparator is ";" which can be checked using Application.International(wdListSeparator) then [a-z]{1;} finds 1 or more characters in the range from "a" to "z" [a-z]{10;} finds 10 or more characters in the range from "a" to "z" See: http://word.mvps.org/faqs/general/UsingWildcards.htm Still more info here: http://www.gmayor.com/replace_using_wildcards.htm and note the section on "Gremlins to be aware of ..." Not everybody likes wildcards. Visit: microsoft.public.de.word.vba MVP Thomas Gahler, one of the very very advanced, whom I regard as my teacher, seems to avoid them altogether. MVP Klaus Linke, contributing in german and english groups, however, is a master in using wildcards. What he wouldn't be, if he didn't like them. I personally don't like too complicated wildcard patterns and I code searches rather on a lower level, which is less buggy, too. But what we have used in your case is very simple. SignatureGreetings from Bavaria, Germany Helmut Weber, MVP WordVBA Win XP, Office 2003 "red.sys" & Chr$(64) & "t-online.de" |
Reply to this Message |
 Sign In
 Join
 My Latest Posts My Monitored Threads My Blog My Photo Gallery My Profile My Homepage Start New Thread Enable EMail Alerts Rate this Thread
|
©2008 Advenet LLC Privacy Policy - Terms of Use
This website includes both content owned or controlled by Advenet as well as content owned or controlled by third parties.