#1
|
|||
|
|||
Append text to a sentence containing specific word
Hi,
I have two scenarios to automate.Appreciate if some one could help. 1) I need find all sentences having 'shall' as the word.The sentence has to be appended with a serial number. Eg:- a)XYZ shall produce 10 units.Atleast 9 units shall be functional. b)ABX shall deliver in 3 days. For above scenario,I require below result a)XYZ shall produce 10 units[R001].Atleast 9 units shall be functional[R002]. b)ABX shall deliver in 3 days[R003]. 2)I need find all sentences having 'may' or 'should'as the word.The sentence has to be appended with a different serial number. Eg:- a)XYZ may be delivered by flight.Delay of 6 hours may be allowed. b)ABX may deliver in wooden boxes. For above scenario,I require below result a)XYZ may be delivered by flight[M001].Delay of 6 hours may be allowed[M002]. b)ABX should be delivered in wooden boxes[M003]. I tried below code but,it works for paragraphs and not sentences. Code:
Sub NumberShallTags() iParCount = ActiveDocument.Paragraphs.Count cnt = 1 For J = 1 To iParCount Set objParagraph = ActiveDocument.Paragraphs(J).Range objParagraph.Find.Text = "shall" objParagraph.Find.ClearFormatting objParagraph.Find.Execute If objParagraph.Find.Found Then sMyPar = ActiveDocument.Paragraphs(J).Range.Text ActiveDocument.Paragraphs(J).Range.Text = sMyPar + "[AMDB-" & Right("00" & Trim(CStr(cnt)), 3) + "]" cnt = cnt + 1 End If Next J End Sub |
#2
|
||||
|
||||
You could use something like:
Code:
Sub Demo() Application.ScreenUpdating = False ActiveDocument.ActiveWindow.View.ShowFieldCodes = True Dim RngTag As Range, ArrFnd, i As Long ArrFnd = Array("must", "shall") For i = 0 To UBound(ArrFnd) With ActiveDocument.Range With .Find .ClearFormatting .Replacement.ClearFormatting .Text = ArrFnd(i) .Replacement.Text = "" .Forward = True .Wrap = wdFindStop .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False .Execute End With Do While .Find.Found Set RngTag = .Duplicate With RngTag .End = .Sentences.First.End - 1 While (.Characters.Last = Chr(19)) Or (.Characters.Last = Chr(23)) .End = .End - 1 Wend .Collapse wdCollapseEnd End With .Fields.Add RngTag, wdFieldEmpty, "SEQ R \# '[R'000']'", False .Collapse wdCollapseEnd .Find.Execute Loop End With Next ArrFnd = Array("may", "should") For i = 0 To UBound(ArrFnd) With ActiveDocument.Range With .Find .ClearFormatting .Replacement.ClearFormatting .Text = ArrFnd(i) .Replacement.Text = "" .Forward = True .Wrap = wdFindStop .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False .Execute End With Do While .Find.Found Set RngTag = .Duplicate With RngTag .End = .Sentences.First.End - 1 While (.Characters.Last = Chr(19)) Or (.Characters.Last = Chr(23)) .End = .End - 1 Wend .Collapse wdCollapseEnd End With .Fields.Add RngTag, wdFieldEmpty, "SEQ M \# '[M'000']'", False .Collapse wdCollapseEnd .Find.Execute Loop End With Next ActiveDocument.Fields.Update ActiveDocument.ActiveWindow.View.ShowFieldCodes = False Application.ScreenUpdating = True End Sub Mr. Smith spent $1,234.56 at Dr. John's Grocery Store, to buy: 10.25kg of potatoes; 10kg of avocados; and 15.1kg of Mrs. Green's Mt. Pleasant macadamia nuts. For you and me, that would probably count as one sentence; for VBA it counts as 5...
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#3
|
|||
|
|||
Thank you macropod! I am getting largely what I need and can live with that :-)
Your note in the end is absolutely right.I noticed that ,it worked for below correctly 1)The horizontal reference for all position data shall be the WGS-84 ellipsoid.[R001] And failed in below cases as you cautioned me 2)It is expected that for many applications, implementation may include conversion to a local coordinate system (e.g.[M001] Cartesian) along with at least one geodetic reference point. Data quality shall be preserved when performing coordinate system conversion.[R003] 3)3.1.5 The metric system shall be used for all linear measurements (e.g.,[R007] runway length). Can we control the insertion of tag before the period('.') ? |
#4
|
||||
|
||||
In what sense? Do you want the tag before the period, or after, as it is now? On the assumption you want the tags before the period (etc.), try:
Code:
Sub Demo() Application.ScreenUpdating = False Dim ArrFnd, i As Long, wdDoc As Document Set wdDoc = ActiveDocument wdDoc.ActiveWindow.View.ShowFieldCodes = True ArrFnd = Array("must", "shall") For i = 0 To UBound(ArrFnd) Call TagIt(wdDoc, ArrFnd(i), "R") Next ArrFnd = Array("may", "should") For i = 0 To UBound(ArrFnd) Call TagIt(wdDoc, ArrFnd(i), "M") Next With wdDoc .Fields.Update .ActiveWindow.View.ShowFieldCodes = False End With Application.ScreenUpdating = True End Sub Sub TagIt(wdDoc As Document, strFnd As Variant, strTag As String) Dim RngTag As Range With wdDoc.Range With .Find .ClearFormatting .Replacement.ClearFormatting .Text = strFnd .Replacement.Text = "" .Forward = True .Wrap = wdFindStop .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False .Execute End With Do While .Find.Found Set RngTag = .Duplicate With RngTag .End = .Sentences.First.End - 2 While Not .Characters.Last.Next.Text Like "[.!?]" .End = .End - 1 Wend While (.Characters.Last = Chr(19)) Or (.Characters.Last = Chr(23)) .End = .End - 1 Wend .Collapse wdCollapseEnd End With .Fields.Add RngTag, wdFieldEmpty, "SEQ " & strTag & " \# '[" & strTag & "'000']'", False .Collapse wdCollapseEnd .Find.Execute Loop End With End Sub
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Word table - how do I append % symbol to each value in columns 3 & 4 of a table | Dawsie | Word | 4 | 03-06-2013 12:33 AM |
Insert text at the end of a sentence Find/Replace | AlmostFriday | Word | 6 | 06-17-2012 05:21 AM |
Deleteing specific text in word document | ubns | Word | 1 | 05-31-2012 10:38 PM |
Change on 1 sentence applied to the whole text | flexible | Word | 2 | 05-03-2012 02:25 AM |
Append text to a cell with color | gvdm | Excel | 1 | 04-17-2012 10:21 AM |