#1
|
|||
|
|||
Conditional_Replacing
Hello, I am using find and replace and it seems to work fine but I need to modify it. Here is the code.
Code:
Sub findMm() Dim strfind() As Variant Dim strreplace() As Variant Dim i As Integer strfind = Array("A", "An", "The", "To", "With" ) strreplace = Array("a", "an", "the", "to","with") For i = 0 To UBound(strfind) With Selection.find .ClearFormatting .Replacement.ClearFormatting .Text = strfind(i) .Format = True .Forward = True .MatchWildcards = False .MatchCase = True .Replacement.Text = strreplace(i) .Execute Replace:=wdReplaceAll End With Next i End Sub For Example: To Find The Answer Of The Question. With The Help Of People. Replace the text except for the first word To Find the Answer to the Question. With the help of People. How can it be done?? Thanks in advance. |
#2
|
||||
|
||||
The following should work, however I suspect you may be converting to true title case in which case see VBA Code Examples (2)
Code:
Sub findMm() Dim oRng As Range Dim strfind() As Variant Dim strreplace() As Variant Dim i As Integer strfind = Array("A", "An", "The", "To", "With") strreplace = Array("a", "an", "the", "to", "with") For i = 0 To UBound(strfind) Set oRng = ActiveDocument.Range With oRng.Find .ClearFormatting .Replacement.ClearFormatting .Text = strfind(i) .Format = True .Forward = True .MatchWildcards = False .MatchCase = True .MatchWholeWord = True Do While .Execute If Not oRng.Start = oRng.Sentences(1).Start Then oRng.Text = strreplace(i) End If oRng.Collapse 0 Loop End With Next i Set oRng = Nothing End Sub
__________________
Graham Mayor - MS MVP (Word) (2002-2019) Visit my web site for more programming tips and ready made processes www.gmayor.com |
#3
|
|||
|
|||
Thanks, Boss!!
|
#4
|
|||
|
|||
Sorry to bother you again sir, But I am facing some difficulties to implement these solutions that you provided on your website for Truetitlecase
Code:
Option Explicit Sub TrueTitleCase() Dim sText As Range Dim vFindText As Variant Dim vReplText As Variant Dim i As Long Dim k As Long Dim m As Long Set sText = Selection.Range 'count the characters in the selected string k = Len(sText) If k < 1 Then 'If none, then no string is selected 'so warn the user MsgBox "Select the text first!", vbOKOnly, "No text selected" Exit Sub 'and quit the macro End If 'format the selected string as title case sText.Case = wdTitleWord 'list the exceptions to look for in an array vFindText = Array("A", "An", "And", "As", "At", "But", "By", "For", _ "If", "In", "Of", "On", "Or", "The", "To", "With") 'list their replacements in a matching array vReplText = Array("a", "an", "and", "as", "at", "but", "by", "for", _ "if", "in", "of", "on", "or", "the", "to", "with") With sText With .Find 'replace items in the first list 'with the corresponding items from the second .ClearFormatting .Replacement.ClearFormatting .Forward = True .Wrap = wdFindStop .MatchWholeWord = True .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False .Format = True .MatchCase = True For i = LBound(vFindText) To UBound(vFindText) .Text = vFindText(i) .Replacement.Text = vReplText(i) .Execute Replace:=wdReplaceAll Next i End With 'Reduce the range of the selected text 'to encompass only the first character .MoveEnd Unit:=wdCharacter, Count:=-Len(sText) + 1 'format that character as upper case .Case = wdUpperCase 'restore the selected text to its original length .MoveEnd Unit:=wdCharacter, Count:=k 'and check to see if the string contains a colon If InStr(1, sText, ":") > 0 Then 'If it does note the position of the character 'after the first colon m = InStr(1, sText, ":") + 1 'and set that as the new start of the selected text .MoveStart wdCharacter, m 'set the end of the selected text to include 'one extra character .MoveEnd Unit:=wdCharacter, Count:=-Len(sText) + 1 'format that character as upper case .Case = wdUpperCase End If End With lbl_Exit: Exit Sub End Sub |
#5
|
||||
|
||||
If I understand correctly, you wish to capitalize the character following a colon in the selection? In that case:
Code:
Sub TrueTitleCase() Dim rSel As Range, oRng As Range Dim vFindText As Variant Dim vReplText As Variant Dim i As Long Dim k As Long Set oRng = Selection.Range Set rSel = Selection.Range 'count the characters in the selected string k = Len(rSel) If k < 1 Then 'If none, then no string is selected 'so warn the user MsgBox "Select the text first!", vbOKOnly, "No text selected" Exit Sub 'and quit the macro End If 'format the selected string as title case vFindText = Array("A", "An", "And", "As", "At", "But", "By", "For", _ "If", "In", "Of", "On", "Or", "The", "To", "With") 'list their replacements in a matching array vReplText = Array("a", "an", "and", "as", "at", "but", "by", "for", _ "if", "in", "of", "on", "or", "the", "to", "with") With rSel .Case = wdTitleWord 'list the exceptions to look for in an array With .Find 'replace items in the first list 'with the corresponding items from the second .ClearFormatting .Replacement.ClearFormatting .Forward = True .Wrap = wdFindStop .MatchWholeWord = True .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False .Format = True .MatchCase = True For i = LBound(vFindText) To UBound(vFindText) .Text = vFindText(i) .Replacement.Text = vReplText(i) .Execute Replace:=wdReplaceAll Next i End With End With FixColon oRng lbl_Exit: Set rSel = Nothing Set oRng = Nothing Exit Sub End Sub Private Sub FixColon(oRng As Range) Const sList As String = "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" Dim rSel As Range oRng.Select Set rSel = Selection.Range With rSel.Find .Text = ":" Do While .Execute If rSel.InRange(oRng) = False Then Exit Do rSel.MoveStartUntil sList rSel.Characters(1).Case = wdUpperCase rSel.Collapse 0 Loop End With oRng.Select lbl_Exit: Exit Sub End Sub
__________________
Graham Mayor - MS MVP (Word) (2002-2019) Visit my web site for more programming tips and ready made processes www.gmayor.com |
#6
|
|||
|
|||
Thanks for the reply sir. And also sorry if I had failed to make you understand my situation. I have to work on word documents where I encounter these types of conditions:
I use to select the words till ":" by looping through every paragraph and using following code Code:
With Selection .MoveLeft Unit:=wdWord, Count:=1 .MoveRight Unit:=wdWord, Count:=3 .StartIsActive = False .Extend Character:=":" If Selection.Range.Bold = True Then TrueTitleCase End If .Collapse End With b. it say's law in money economy: In the money economy, products are sold c. if say's law in money economy: In the money economy, products are sold d. the say's law in money economy: In the money economy, products are e. on say's law in money economy: In the money economy, products are f. a say's law in money economy: In the money economy, products are sold sold This is just the sample text what happens here, the code changes all the selection word to wdtitle case. Everything is fine till here now I just want to ignore the first word of the selection (For example If ("The","If","On") etc. If Vfindtext(i) is in the first word of the sentence then ignore it. If it is in other places (except the first word of selection) Then replace it like: a. Say's Law in the Barter Economy: In barter economy, goods are produced either b. It Say's Law in Money Economy: In the money economy, products are sold c. If Say's Law in Money Economy: In the money economy, products are sold d. The Say's Law in Money Economy: In the money economy, products are e. On Say's Law in Money Economy: In the money economy, products are f. A Say's Law in Money Economy: In the money economy, products are sold Thank you for your help. |
#7
|
||||
|
||||
Based on your example, the following should work with selected paragraphs:
Code:
Sub FormatPara() Dim oPara As Paragraph Dim oRng As Range For Each oPara In Selection.Paragraphs Set oRng = oPara.Range oRng.End = oRng.End - 1 If oRng.Characters(2) = "." Then oRng.MoveStart 2 End If If InStr(1, oPara.Range.Text, ":") > 0 Then oRng.Collapse 1 oRng.MoveEndUntil ":" End If TrueTitleCase oRng Next oPara lbl_Exit: Set oPara = Nothing Set oRng = Nothing Exit Sub End Sub Private Sub TrueTitleCase(oRng As Range) Dim rSel As Range Dim vFindText As Variant Dim vReplText As Variant Dim i As Long Dim k As Long Set rSel = oRng 'count the characters in the selected string k = Len(rSel) If k < 1 Then 'If none, then no string is selected 'so warn the user MsgBox "Select the text first!", vbOKOnly, "No text selected" Exit Sub 'and quit the macro End If 'format the selected string as title case vFindText = Array("A", "An", "And", "As", "At", "But", "By", "For", _ "If", "In", "Of", "On", "Or", "The", "To", "With") 'list their replacements in a matching array vReplText = Array("a", "an", "and", "as", "at", "but", "by", "for", _ "if", "in", "of", "on", "or", "the", "to", "with") With rSel .Case = wdTitleWord 'list the exceptions to look for in an array With .Find 'replace items in the first list 'with the corresponding items from the second .ClearFormatting .Replacement.ClearFormatting .Forward = True .Wrap = wdFindStop .MatchWholeWord = True .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False .Format = True .MatchCase = True For i = LBound(vFindText) To UBound(vFindText) .Text = vFindText(i) .Replacement.Text = vReplText(i) .Execute Replace:=wdReplaceAll Next i End With End With lbl_Exit: Set rSel = Nothing Exit Sub End Sub
__________________
Graham Mayor - MS MVP (Word) (2002-2019) Visit my web site for more programming tips and ready made processes www.gmayor.com |
#8
|
|||
|
|||
Sorry to say this sir, But it still failed to address my problem. What the code should be able to do is, if first word of the selection is in vfindtext(i) then just ignore it and replace all from the second word. For example, many sentences start from To, The, A, An etc. which are listed in vfindtext array I don't want to replace them if they are in the starting position of range or sentences Else replace them. The above code works excellent just fails to address this problem.
|
#9
|
||||
|
||||
The following adopts a slightly different approach. Change the first macro to
Code:
Sub FormatPara() Dim oPara As Paragraph Dim oRng As Range For Each oPara In Selection.Paragraphs Set oRng = oPara.Range oRng.End = oRng.End - 1 If Len(oRng) > 2 Then If oRng.Characters(2) = "." Then oRng.MoveStart 3 oRng.MoveStartWhile Chr(9) oRng.MoveStartWhile Chr(32) oRng.MoveStartWhile Chr(160) End If If InStr(1, oPara.Range.Text, ":") > 0 Then oRng.Collapse 1 oRng.MoveEndUntil ":" End If TrueTitleCase oRng oRng.Characters(1).Case = wdUpperCase End If Next oPara lbl_Exit: Set oPara = Nothing Set oRng = Nothing Exit Sub End Sub
__________________
Graham Mayor - MS MVP (Word) (2002-2019) Visit my web site for more programming tips and ready made processes www.gmayor.com |
#10
|
|||
|
|||
Thank you, boss. With little modification, it perfectly meets my needs.
|
Thread Tools | |
Display Modes | |
|