![]() |
#1
|
|||
|
|||
![]() Hi guys, I'm looking to update the macro below. In the word document attached, highlighted row, at the beginning of the definition the quote mark should insert after the square bracket. I also need to remove any punctuation at the end of the definition before the square bracket (the macro below does remove punctuation and replaces it with a semi-colon but I'm not sure how to tell it to remove punctuation if the sentence ends with a square bracket). Any help would be appreciated. Many thanks. Definitions.docx 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 'Remove colons' .Text = ":" .Font.Bold = True .Replacement.Text = "" .Execute Replace:=wdReplaceAll End With With orng.Find 'Remove colons' .Text = ":""" .Replacement.Text = """" .Execute Replace:=wdReplaceAll End With With orng.Find 'remove bold from spaces after the word means .Text = "means " .Replacement.Text = "means " .Replacement.Font.Bold = False .Execute Replace:=wdReplaceAll End With 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 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" .MatchWildcards = True .Execute Replace:=wdReplaceAll End With With orng.Find 'Remove double quotes' .Text = """" .Replacement.Text = "" .Execute Replace:=wdReplaceAll End With Set orng = ActiveDocument.Range 'Replace tab with space' With orng.Find .Text = "^t" .Replacement.Text = " " .Execute Replace:=wdReplaceAll End With Set orng = ActiveDocument.Range 'Bold quotes 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.Font.Bold = False orng.Characters.Last = vbTab 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 'Remove the words means from each definition and insert a tab' Set orng = ActiveDocument.Range With orng.Find .Text = "^tmeans" .Replacement.Text = "^t" .Execute Replace:=wdReplaceAll End With 'Remove the words means and space before and insert a tab' Set orng = ActiveDocument.Range With orng.Find .Text = " ^tmeans" .Replacement.Text = "^t" .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 With orng.Find 'Remove colons' .Text = ":""" .Replacement.Text = """" .Execute Replace:=wdReplaceAll End With 'Highligt tabs 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 'Insert semi-colon at end of sentences but not for and, but, or Set orng = ActiveDocument.Range With orng.Find .Text = ".^p" .Replacement.Text = "^p" .Execute Replace:=wdReplaceAll End With 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" 'do nothing Case Else .Characters.Last.InsertBefore ";" End Select End If End If 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 Sub Code:
Sub ResetFRParameters() With Selection.Find .ClearFormatting .Replacement.ClearFormatting .Text = "" .Replacement.Text = "" .Forward = True .Wrap = wdFindStop .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False .Execute End With lbl_Exit: Exit Sub End Sub |
|
![]() |
||||
Thread | Thread Starter | Forum | Replies | Last Post |
Insert Block Quote into Numbered List | krose4088 | Word | 4 | 12-10-2020 02:29 PM |
![]() |
Dave T | Word VBA | 2 | 04-28-2019 11:00 PM |
![]() |
jeffreybrown | Word VBA | 8 | 12-04-2018 06:01 PM |
Word 2010 - Remove square-bracket encased string in large document | IntestinalWorm | Word | 1 | 06-20-2017 01:14 AM |
![]() |
nothing_kills | Drawing and Graphics | 7 | 01-20-2014 10:57 PM |