![]() |
#3
|
|||
|
|||
![]()
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 |
|
![]() |
||||
Thread | Thread Starter | Forum | Replies | Last Post |
![]() |
Jamal NUMAN | Word | 3 | 02-26-2019 02:33 PM |
![]() |
fariz | Word | 2 | 10-31-2016 12:57 AM |
![]() |
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 |