#16
|
||||
|
||||
Hi dexter30,
The only practical way to do that is with a macro. Try: Code:
Sub Demo() With ActiveDocument.Content With .Find .ClearFormatting .Replacement.ClearFormatting .Text = "^13DO[S ]{1,2}VEREADOR*^13DO[S ]{1,2}VEREADOR" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = True .Execute End With Do While .Find.Found .End = .Start + InStrRev(.Text, vbCr) - 2 .Start = .Start + 1 .Start = .Start + InStr(.Text, vbCr) .Text = Replace(.Text, vbCr, " ") .Collapse wdCollapseEnd .Find.Execute Loop End With End Sub
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#17
|
|||
|
|||
In the attached file (PD_BEFORE) the macro works for the first four 'Nº [0-9]{1;8}' strings. I doesn´t do for the last one (Nº 516/2013), then MS Word freezes and I have to force it shut down.
The result after executing the macro 'Demo' is shown in the PD_AFTER_Sub_Demo file. Note also that it merged Nº 499/2013 and Nº 507/2013 (DA VEREADORA, I think you skipped this possibility) Last edited by dexter30; 04-22-2013 at 10:02 AM. |
#18
|
||||
|
||||
I did warn you that the last one wouldn't be processed and that other instances between the 'DO(S) VEREADOR(A/ES)' ranges would be merged into them.
To handled 'DA' as well, change: .Text = "^13DO[S ]{1,2}VEREADOR*^13DO[S ]{1,2}VEREADOR" to: .Text = "^13D[AO][S ]{1,2}VEREADOR*^13D[AO][S ]{1,2}VEREADOR" For the 'freezing' try changing: .Wrap = wdFindContinue to: .Wrap = wdFindStop
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#19
|
|||
|
|||
Yes now it works and doesn´t freeze anymore.
I just realized that there can be more than one 'Nº [0-9]{1;8}' for each 'DO/A(S) VEREADOR(A/ES)'. Can you please update the macro to handle it? Also isn´t really there a way to process the last one? Example files attached. Thank you. |
#20
|
||||
|
||||
Doing all this stuff makes the macro much more complicated:
Code:
Sub Test() Application.ScreenUpdating = False Dim i As Long With ActiveDocument.Range With .Find .ClearFormatting .Replacement.ClearFormatting .Forward = True .Wrap = wdFindStop .MatchWildcards = True .Text = "[^13]{2,}" .Replacement.Text = "^p" .Execute Replace:=wdReplaceAll .Text = "^13D[AO][S ]{1,2}VEREADOR*^13" .Replacement.Text = "" .Execute End With Do While .Find.Found .Start = .Start + 1 Do While .Paragraphs.Last.Next.Range.Font.Bold = False And .Paragraphs.Last.Next.Range.End <> ActiveDocument.Range.End .MoveEnd wdParagraph, 1 Loop For i = .Paragraphs.Count To 2 Step -1 If Not .Paragraphs(i).Range.Text Like "Nº #*" Then If Not .Paragraphs(i).Range.Text Like "D[AO][S ]*VEREADOR*" Then .Paragraphs(i).Range.Characters.First.Previous = " " End If Next .Collapse wdCollapseEnd .Find.Execute Loop With .Find .Forward = True .Wrap = wdFindContinue .MatchWildcards = True .Text = "[^13]" .Replacement.Text = "^p^p" .Execute Replace:=wdReplaceAll .Text = "(^13D[AO][S ]{1,2}VEREADOR*)[^13]{1,}" .Replacement.Text = "\1^p" .Execute Replace:=wdReplaceAll End With End With With ActiveDocument.Range While .Characters.Last.Previous.Text = vbCr .Characters.Last.Previous.Text = vbNullString Wend End With Application.ScreenUpdating = True End Sub
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#21
|
|||
|
|||
Awesome job. This would save me a lot of everyday work.
Don´t understand though why the script inserts several blank lines in the beginning of the file. Also, in the last 'Nº [0-9]{1;8}' the paragraph turned to 'Multiple' (menu Format/Paragraph/Between Lines) where it should be 'Single'. Thank you. |
#22
|
||||
|
||||
Quote:
Quote:
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#23
|
|||
|
|||
Quote:
Quote:
Thank you. |
#24
|
||||
|
||||
Try the following update:
Code:
Sub Test() Application.ScreenUpdating = False Dim i As Long, RngFnd As Range, RngTmp As Range With ActiveDocument Set RngFnd = .Range Set RngTmp = .Range With .Range With .Find .ClearFormatting .Replacement.ClearFormatting .Forward = True .Wrap = wdFindStop .MatchWildcards = True .Text = "^13D[ao][s ]{1,2}Vereador*^13" .Replacement.Text = "" .Execute End With RngFnd.Start = .Start RngTmp.Start = .Start End With With RngTmp With .Find .ClearFormatting .Replacement.ClearFormatting .Forward = True .Wrap = wdFindStop .MatchWildcards = True .Text = "[^13]{2,}" .Replacement.Text = "^p" .Execute Replace:=wdReplaceAll .Text = "^13D[ao][s ]{1,2}Vereador*^13" .Replacement.Text = "" .Execute End With Do While .Find.Found .Start = .Start + 1 Do While .Paragraphs.Last.Next.Range.Font.Bold = False And .Paragraphs.Last.Next.Range.End <> ActiveDocument.Range.End .MoveEnd wdParagraph, 1 Loop For i = .Paragraphs.Count To 2 Step -1 If Not .Paragraphs(i).Range.Text Like "Nº #*" Then If Not .Paragraphs(i).Range.Text Like "D[ao][s ]*Vereador*" Then .Paragraphs(i).Range.Characters.First.Previous = " " End If Next .Collapse wdCollapseEnd .Find.Execute Loop End With Set RngTmp = RngFnd With RngTmp.Find .Forward = True .Wrap = wdFindStop .MatchWildcards = True .Text = "[^13]" .Replacement.Text = "^p^p" .Execute Replace:=wdReplaceAll .Text = "(^13D[ao][s ]{1,2}Vereador*)[^13]{1,}" .Replacement.Text = "\1^p" .Execute Replace:=wdReplaceAll End With With .Range While .Characters.Last.Previous.Text = vbCr .Characters.Last.Previous.Text = vbNullString Wend End With End With Application.ScreenUpdating = True End Sub
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#25
|
|||
|
|||
It worked like a charm. I really appreciate your help.
Believe it or not, my boss told me to include a new part in the document named PROPOSITURAS RESPONDIDAS, and this one is being affected by the script. Right after 'PROPOSITURAS RESPONDIDAS' every block of text to be merged begins with either of the following: 'Do Vereador XXX:' / 'Dos Vereadores XXX, YYY e ZZZ:' / 'Da Vereadora XXX:' / 'Das Vereadoras XXX, YYY e ZZZ:' / 'Do Vereador XXX e Da Vereadora XXX:' / 'Dos Vereadores XXX, YYY e ZZZ e Das Vereadora XXX, YYY e ZZZ:' Then there may be either of the following: Indicação nº / Indicações nºs Requerimento nº / Requerimentos nºs Moção nº / Moções nºs Ofício de Gabinete nº / Ofícios de Gabinete nºs Note that a semicolon must be inserted to separate each series of Indicações / Requerimentos / Moções / Ofícios de Gabinete Example files attached. Thanks again. |
#26
|
||||
|
||||
This is the fifth change to your requirements you've made in this thread. I really don't enjoy having to re-do stuff just because the requirements haven't been properly specified from the start.
Since you say your boss wants to include a new part to the document, how about adding that after the macro has been run? Your additional requirements are expanding the project way beyond what its reasonable to seek free help for ...
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#27
|
|||
|
|||
Quote:
Quote:
Anyway thanks a lot for your help and time, you guys do an awesome job here. |
#28
|
|||
|
|||
Would you consider solve this one, it's really the LAST thing I need to get the document ready.
|
#29
|
||||
|
||||
Try the following:
Code:
Sub Reformat() Application.ScreenUpdating = False Dim i As Long, RngFnd As Range With ActiveDocument Set RngFnd = .Range With .Range With .Find .ClearFormatting .Replacement.ClearFormatting .Forward = True .Wrap = wdFindStop .MatchWildcards = True .Text = "[^13]{1,}D[ao][s ]{1,2}Vereador*^13" .Replacement.Text = "" .Execute End With RngFnd.Start = .Start + 1 End With With RngFnd With .Find .ClearFormatting .Replacement.ClearFormatting .Forward = True .Wrap = wdFindStop .MatchWildcards = True .Text = "[^13]{1,}" .Replacement.Text = "^p^p" .Execute Replace:=wdReplaceAll .Text = "[ ]{1,}^13" .Replacement.Text = "^p" .Execute Replace:=wdReplaceAll .Text = "[^13]{1,}(D[ao][s ]{1,2}Vereador*)([^13]{1,})" .Replacement.Text = "^p\1^l" .Execute Replace:=wdReplaceAll .Text = "[^13]{1,}(Nº)" .Replacement.Text = "^p^l\1" .Execute Replace:=wdReplaceAll .Text = "[^13]{1,}(MATÉRIA DO LEGISLATIVO)[^13]{1,}" .Replacement.Text = "^p^l\1^l^p" .Execute Replace:=wdReplaceAll .Text = "[^13]{1,}(INDICAÇÕES)[^13]{1,}" .Replacement.Text = "^p^l\1^l^p" .Execute Replace:=wdReplaceAll .Text = "[^13]{1,}(MOÇÕES)[^13]{1,}" .Replacement.Text = "^p^l\1^l^p" .Execute Replace:=wdReplaceAll .Text = "[^13]{2,}" .Replacement.Text = " " .Execute Replace:=wdReplaceAll .Text = "^l" .Replacement.Text = "^p" .Execute Replace:=wdReplaceAll .Text = "[^13]{1,}(D[ao][s ]{1,2}Vereador*)([^13]{1,})" .Replacement.Text = "^p^p\1^p" .Execute Replace:=wdReplaceAll End With End With End With Application.ScreenUpdating = True End Sub
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#30
|
|||
|
|||
Fantastic. Close to perfection.
Remember I said that a semicolon should be inserted to separate each series of Indicações / Requerimentos / Moções / Ofícios de Gabinete? Like this: BEFORE Da Vereadora Arminda Gonda: Indicações n°s 5864 de 2012, 854, 856, 973, 982, 984, 1017, 1022, 1343, 1345, 1346, 1347 e 1349 de 2013 Requerimento n° 77 de 2013 Moção nº 30 de 2013 AFTER Da Vereadora Arminda Gonda: Indicações n°s 5864 de 2012, 854, 856, 973, 982, 984, 1017, 1022, 1343, 1345, 1346, 1347 e 1349 de 2013; Requerimento n° 77 de 2013; Moção nº 30 de 2013 Thank you. |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Macro to find text in between two characters and then format selected text? | qcom | Word | 5 | 02-19-2015 11:23 PM |
automatically format meetings by me with some attendee | wsw70 | Outlook | 0 | 06-24-2011 12:16 AM |
Objective: Automatically export email text,attachment text to DB friendly format | SilentLee | Outlook | 0 | 11-14-2010 02:45 PM |
automatically extract footnotes into new file and apply character format to footnote | hrdwa | Word | 0 | 02-27-2010 03:16 AM |
format cells to automatically place quotes around text | dirtleg | Excel | 1 | 09-16-2008 01:52 PM |