#1
|
|||
|
|||
VBA code help: replacing punctuation
Hi, I would like to tidy up this code.
1. After each sentence the code runs to remove punctuation and replace with a semi-colon. It doesn't seem to work unless I put the .Text = ".^p" bit of the code to remove periods first though. Is there a better way to do this? 2. The code needs to remove punctuation before a square bracket at the end of sentences only. I have put the code in as .Text = ".]^p" etc. which removes punctuation, what I need is for the code that inserts the semi-colon, to search for square brackets and insert the semi-colon before the square bracket not after it. I'm really not sure how to make this happen, can anyone help please. Code:
'Remove period from end of sentence Set orng = ActiveDocument.Range With orng.Find .Text = ".^p" .Replacement.Text = "^p" .Execute Replace:=wdReplaceAll End With 'Remove period before square bracket at end of sentence Set orng = ActiveDocument.Range With orng.Find .Text = ".]^p" .Replacement.Text = "]^p" .Execute Replace:=wdReplaceAll End With 'Insert semi-colon at end of sentences but not for and, but, or, then Set orng = ActiveDocument.Range For Each Para In ActiveDocument.Paragraphs With Para.Range If Len(.Text) > 2 Then If Not .Characters.Last.Previous Like "[.!?:;]" Then Select Case .Words.Last.Previous.Words(1) Case "and", "but", "or", "then" 'do nothing Case Else .Characters.Last.InsertBefore ";" End Select End If End If End With |
#2
|
||||
|
||||
Without seeing some sample content, it's hard to know exactly what needs to be done. Try:
Code:
Sub Demo() Application.ScreenUpdating = False With ActiveDocument.Range With .Find .Wrap = wdFindStop .MatchWildcards = True .Text = "[! ^13]@[!.\!\?:;]^13" .Replacement.Text = "" .Execute End With Do While .Find.Found = True Select Case Trim(.Words.First) Case "and", "but", "or", "then" 'do nothing Case Else .Words.First.InsertAfter ";" End Select .Collapse wdCollapseEnd .Find.Execute Loop End With Application.ScreenUpdating = True End Sub
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#3
|
|||
|
|||
VBA code help: replacing punctuation
Hi Macropod, many thanks for the code. I'm having an error with 'Do While.Find.Found = True' - error says 'Method or data member not found'. I have inserted the full code I'm trying to get it to work in after your code.
Definition Test Doc.docx Code:
'Remove punctuation and insert semi-colon at end of sentence Set orng = ActiveDocument.Range With orng.Find .Wrap = wdFindStop .MatchWildcards = True .Text = "[! ^13]@[!.\!\?:;]^13" .Replacement.Text = "" .Execute Replace:=wdReplaceAll End With Do While .Find.Found = True Select Case Trim(.Words.First) Case "and", "but", "or", "then" 'do nothing Case Else .Words.First.InsertAfter ";" End Select .Collapse wdCollapseEnd .Find.Execute Loop End With Code:
Sub DPU_Definitions() Dim orng As Range Dim Para As Paragraph Application.ScreenUpdating = False 'Create placeholder. ActiveDocument.Range.InsertBefore vbCr ActiveDocument.Paragraphs(1).Range.Font.Bold = False 'Convert numbers to text' ActiveDocument.Range.ListFormat.ConvertNumbersToText Set orng = ActiveDocument.Range ResetFRParameters With orng.Find 'Delete white spaces before paragraph breaks .Text = "^w^p" .Replacement.Text = "^p" .Execute Replace:=wdReplaceAll End With With orng.Find 'Delete white spaces after paragraph breaks .Text = "^p^w" .Execute Replace:=wdReplaceAll End With With orng.Find .ClearFormatting .Replacement.ClearFormatting .Text = "[:;, ^t]{1,5}means[:;, ]{1,5}" .Replacement.Text = "^t" .Replacement.Font.Bold = False .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = True .Execute Replace:=wdReplaceAll With orng.Find Set orng = ActiveDocument.Range With orng.Find 'Remove bold formatting from punctuation and para marks .Text = "[" & Chr(13) & ".;,:]" .MatchWildcards = True .Font.Bold = True .Replacement.Font.Bold = False .Execute Replace:=wdReplaceAll End With 'Clear space before tabs With orng.Find .Text = " ^t" .Replacement.Text = "^t" .Replacement.Font.Bold = False .MatchWildcards = True .Execute Replace:=wdReplaceAll End With Set orng = ActiveDocument.Range 'Insert Bold quotes for bold definition text at beginning of sentence With orng.Find .Text = "" .Replacement.Text = "^034^&^034" .Font.Bold = True .Format = True .MatchWildcards = True While .Execute If Not InStr(orng.Text, Chr(13)) Then While orng.Characters.Last = Chr(32) orng.Characters.Last.Font.Bold = False orng.End = orng.End - 1 Wend orng.Text = Chr(34) & orng.Text & Chr(34) If orng.Characters.First.Previous = Chr(13) Then orng.Collapse wdCollapseEnd orng.Characters.Last = vbTab orng.Font.Bold = False Else orng.Collapse wdCollapseEnd End If End If Wend End With ResetFRParameters Set orng = ActiveDocument.Range 'insert tab at beginning of paragraph with a bracket e.g. (a), (i), (1) With orng.Find .MatchWildcards = True .Text = "^13(\([a-z0-9]{1,}\))" .Replacement.Text = "^p^t\1" .Execute Replace:=wdReplaceAll End With 'insert tab at beginning of paragraph e.g a), 1), i), 100 etc. With orng.Find .MatchWildcards = True .Text = "^13([a-z0-9\)]{1,})" .Replacement.Text = "^p^t\1" .Execute Replace:=wdReplaceAll End With Set orng = ActiveDocument.Range 'Clears colons or commas after tabs. With orng.Find .Text = "[^t]([:\,]){1,}" .Replacement.Text = "^t" .MatchWildcards = True .Execute Replace:=wdReplaceAll End With 'Clear space after tabs With orng.Find .Text = "^t " .Replacement.Text = "^t" .MatchWildcards = True .Execute Replace:=wdReplaceAll End With 'Highligt tabs so user can check for errors when code has run Set orng = ActiveDocument.Range Options.DefaultHighlightColorIndex = wdYellow With orng.Find .Text = "^t" .Replacement.Text = "^t" .Replacement.Highlight = True .Execute Replace:=wdReplaceAll End With ResetFRParameters Set orng = ActiveDocument.Range With orng.Find .Text = "^t" Do While .Execute orng.Start = orng.Paragraphs(1).Range.Start If Len(.Text) - Len(Replace(.Text, vbTab, "")) > 1 Then orng.Characters.Last.Text = " " orng.Collapse wdCollapseEnd Loop End With 'Remove punctuation and insert semi-colon at end of sentence Set orng = ActiveDocument.Range With orng.Find .Wrap = wdFindStop .MatchWildcards = True .Text = "[! ^13]@[!.\!\?:;]^13" .Replacement.Text = "" .Execute Replace:=wdReplaceAll End With Do While .Find.Found = True Select Case Trim(.Words.First) Case "and", "but", "or", "then" 'do nothing Case Else .Words.First.InsertAfter ";" End Select .Collapse wdCollapseEnd .Find.Execute Loop End With Next 'Remove placeholder. ActiveDocument.Paragraphs(1).Range.Delete Set orng = ActiveDocument.Range With orng.Find .Text = "^13[A-Za-z]" .MatchWildcards = True Do While .Execute If orng.Paragraphs(2).Style = "Normal" And _ orng.Paragraphs(2).Range.Characters(1).Font.Bold = False Then orng.Paragraphs(2).Range.InsertBefore vbTab End If orng.Collapse 0 Loop End With Application.ScreenUpdating = True lbl_Exit: Set orng = Nothing Exit Sub End With End With End Sub |
#4
|
||||
|
||||
The code I posted previously take a different approach to the rest of your macro. Try:
Code:
Sub DPU_Definitions() Application.ScreenUpdating = False With ActiveDocument With .Range 'Convert list numbers to text' .ListFormat.ConvertNumbersToText 'Create placeholder. .InsertBefore vbCr .Paragraphs(1).Range.Font.Bold = False With .Find .ClearFormatting .Replacement.ClearFormatting .Format = True .Forward = True .MatchWildcards = False .Wrap = wdFindContinue 'Delete white spaces before paragraph breaks .Text = "^w^p" .Replacement.Text = "^p" .Execute Replace:=wdReplaceAll 'Delete white spaces after paragraph breaks .Text = "^p^w" .Execute Replace:=wdReplaceAll 'Clean up definitions .MatchWildcards = True .Text = "[:;, ^t]{1,5}means[:;, ]{1,5}" .Replacement.Text = "^t" .Replacement.Font.Bold = False .Execute Replace:=wdReplaceAll 'Remove bold formatting from punctuation and para marks .Text = "[^13.;,:]" .Replacement.Text = "^&" .Font.Bold = True .Execute Replace:=wdReplaceAll 'Clear space before tabs .Text = "[ ^160]{1,}^t" .Replacement.Text = "^t" .Execute Replace:=wdReplaceAll 'Insert Bold quotes for bold definition text at beginning of sentence .Text = "" .Replacement.Text = "^034^&^034" .Wrap = wdFindStop End With Do While .Find.Execute = True With .Duplicate Do While .Characters.Last = " " .Characters.Last.Delete Loop .InsertBefore Chr(147) .InsertAfter Chr(148) If .Characters.First.Previous = vbCr Then .InsertAfter vbTab .Characters.Last.Font.Bold = False End If End With .End = .End + 1 .Collapse wdCollapseEnd Loop With .Find .Wrap = wdFindContinue 'insert tab at beginning of paragraph with a bracket e.g. (a), a), (i), i), (1), 1) .Text = "^13([\(a-z0-9]@\))" .Replacement.Text = "^p^t\1" .Execute Replace:=wdReplaceAll 'Clear colons or commas after tabs. .Text = "[^t]([:\,]){1,}" .Replacement.Text = "^t" .Execute Replace:=wdReplaceAll 'Clear space after tabs .Text = "^t[ ^160]{1,}" .Execute Replace:=wdReplaceAll 'Highligt tabs so user can check for errors when code has run .Wrap = wdFindStop .Text = "^t" End With Do While .Find.Execute = True With .Duplicate .HighlightColorIndex = wdYellow .Start = .Paragraphs(1).Range.Start If Len(.Text) - Len(Replace(.Text, vbTab, "")) > 1 Then .Characters.Last.Text = " " End With .Collapse wdCollapseEnd Loop End With With .Range 'Remove punctuation and insert semi-colon at end of sentence .Find.Text = "[! ^13]@[!.\!\?:;]^13" Do While .Find.Execute = True With .Duplicate Select Case Trim(.Words.First) Case "and", "but", "or", "then" 'do nothing Case Else .Words.First.InsertAfter ";" End Select End With .Collapse wdCollapseEnd Loop End With 'Remove placeholder. .Paragraphs(1).Range.Delete With .Range 'Prefix designated bold first words with a tab .Find.Text = "^13[A-Za-z]" Do While .Find.Execute = True With .Duplicate.Paragraphs.Last.Range If .Style = "Normal" Then If .Characters.First.Font.Bold = False Then .InsertBefore vbTab End If End With .Collapse wdCollapseEnd Loop End With End With End Sub
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#5
|
|||
|
|||
VBA code help: replacing punctuation
Hi Macropod, many thanks for updating this code for me, very much appreciated. There appears to be 2 message boxes that come up and it won't let me run the macro - MsgBox Chr(34) & .Text & Char(34), how can I amend these so I don't get the message box. Thanks.
Image.JPG Code:
'Remove punctuation and insert semi-colon at end of sentence .Find.Text = "[! ^13]@[!.\!\?:;]^13" Do While .Find.Execute = True With .Duplicate MsgBox Chr(34) & .Text & Chr(34) Select Case Trim(.Words.First) Case "and", "but", "or", "then" 'do nothing Case Else .Words.First.InsertAfter ";" End Select End With .Collapse wdCollapseEnd Loop End With 'Remove placeholder. .Paragraphs(1).Range.Delete With .Range 'Prefix designated bold first words with a tab .Find.Text = "^13[A-Za-z]" Do While .Find.Execute = True MsgBox Chr(34) & .Text & Chr(34) With .Duplicate.Paragraphs.Last.Range If .Style = "Normal" Then If .Characters.First.Font.Bold = False Then .InsertBefore vbTab End If End With .Collapse wdCollapseEnd Loop End With |
#6
|
||||
|
||||
I modified the code soon after posting to remove those - I was using them for testing.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#7
|
|||
|
|||
VBA code help: replacing punctuation
Hi Macropod, I have removed the MsgBox lines in the code. Unfortunately the code is crashing Word with Not Responding and I have to End Task to break out of it. Any ideas?
|
#8
|
||||
|
||||
OK, I've made a few small changes. Try it now.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#9
|
|||
|
|||
VBA code help: replacing punctuation
Hi Macropod, apologies for the late response, I've been trying to get this code to work but it just crashing Word every time and I have to End Task, any ideas. Thanks
|
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
How to delete all the punctuation marks from a paragraph? | Jamal NUMAN | Word | 3 | 02-26-2019 02:33 PM |
punctuation order | fariz | Word | 2 | 10-31-2016 12:57 AM |
Need help with modifying a replacing font VBA code- similar task but subtle change | kissingfrogs2003 | Word VBA | 3 | 08-30-2016 11:42 AM |
Replacing punctuation marks with footnotes | nufc89 | Word | 2 | 05-22-2015 03:15 PM |
Punctuation | lexsper | Word | 0 | 04-06-2015 07:26 AM |