#1
|
|||
|
|||
Help with Definitions Macro
I've got myself into a bit of a muddle with a definitions macro I am trying to put together, I did have help some time ago but have completely forgotten what some of the code does as I stupidly didn't add reminder text within the code for some of it. I need to simplify the code and also remove the quotes and tabs in between words with hyphens, ampersands and brackets. I have attached a document highlighting the issues I'm having and also a document to test the macro on. If anyone can help me I would be eternally grateful. 1. example of issues in definitions macro.docx 2. Test Document for definitions macro.docx Code:
Sub DPU_convertdefinitions() Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting ActiveDocument.Range.ListFormat.ConvertNumbersToText Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = """" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "^t" .Replacement.Text = " " .Forward = True .Wrap = wdFindStop .Format = False .MatchCase = False .MatchWholeWord = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = True End With Selection.Find.Execute Replace:=wdReplaceAll Selection.Find.ClearFormatting Selection.Find.Font.Bold = True Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "<*>" .Replacement.Text = "^034^&^034^t" .Forward = True .Wrap = wdFindStop .Format = True .MatchCase = False .MatchWholeWord = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = True End With Selection.Find.Execute Replace:=wdReplaceAll Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "^034^t ^034" .Replacement.Text = "^032" .Forward = True .Wrap = wdFindStop .Format = False .MatchCase = False .MatchWholeWord = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = True End With Selection.Find.Execute Replace:=wdReplaceAll 'remove space after tab' With Selection.Find .Text = "^t " .Replacement.Text = "^t" .Forward = True .Wrap = wdFindStop .Format = False .MatchCase = False .MatchWholeWord = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = True End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "^p(" .Replacement.Text = "^p^t(" .Forward = True .Wrap = wdFindStop .Format = False .MatchCase = False .MatchWholeWord = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = False End With Selection.Find.Execute Replace:=wdReplaceAll Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting 'remove the words means from each definition and insert a tab' With Selection.Find .Text = "^tmeans" .Replacement.Text = "^t" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting 'remove colon after tab' With Selection.Find .Text = "^t:" .Replacement.Text = "^t" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting 'remove comma after tab' With Selection.Find .Text = "^t," .Replacement.Text = "^t" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting 'remove space after tab' With Selection.Find .Text = "^t " .Replacement.Text = "^t" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll Selection.Find.Execute Replace:=wdReplaceAll Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting 'replace periods with semi colons at end of each definition' With Selection.Find .Text = ".^p" .Replacement.Text = ";^p" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll Dim oRng As Range Const strText As String = "^13[A-Za-z]" Set oRng = ActiveDocument.Range With oRng.Find Do While .Execute(FindText:=strText, MatchWildcards:=True) 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 lbl_Exit: Set oRng = Nothing Exit Sub End Sub |
#2
|
|||
|
|||
So I've managed to sort some of the code regarding hyphens, brackets and ampersands. Still having an issue where a definition does appear in the unbold text and the macro converts it, is there a way to tell the macro to ignore these? I expect the macro could also be coded better as it does seem quite lengthy.
Code:
Sub DPU_convertdefinitions() Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting ActiveDocument.Range.ListFormat.ConvertNumbersToText Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = """" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll 'replace tab with space' With Selection.Find .Text = "^t" .Replacement.Text = " " .Forward = True .Wrap = wdFindStop .Format = False .MatchCase = False .MatchWholeWord = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = True End With Selection.Find.Execute Replace:=wdReplaceAll Selection.Find.ClearFormatting Selection.Find.Font.Bold = True Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "<*>" .Replacement.Text = "^034^&^034^t" .Forward = True .Wrap = wdFindStop .Format = True .MatchCase = False .MatchWholeWord = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = True End With Selection.Find.Execute Replace:=wdReplaceAll 'tab after quote replace with space' With Selection.Find .Text = "^034^t ^034" .Replacement.Text = "^032" .Forward = True .Wrap = wdFindStop .Format = False .MatchCase = False .MatchWholeWord = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = True End With Selection.Find.Execute Replace:=wdReplaceAll 'remove space after tab' With Selection.Find .Text = "^t " .Replacement.Text = "^t" .Forward = True .Wrap = wdFindStop .Format = False .MatchCase = False .MatchWholeWord = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = True End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "^p(" .Replacement.Text = "^p^t(" .Forward = True .Wrap = wdFindStop .Format = False .MatchCase = False .MatchWholeWord = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = False End With Selection.Find.Execute Replace:=wdReplaceAll 'remove the words means from each definition and insert a tab' With Selection.Find .Text = "^tmeans" .Replacement.Text = "^t" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll 'remove colon after tab' With Selection.Find .Text = "^t:" .Replacement.Text = "^t" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll 'remove tab and quotes before hyphen' With Selection.Find .Text = "^034^t^045^034" .Replacement.Text = "-" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll 'remove quote and tab before left bracket' With Selection.Find .Text = "^034^t^040^034" .Replacement.Text = " (" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll 'remove quote tab before right bracket' With Selection.Find .Text = "^034^t^041 ^034" .Replacement.Text = ") " .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll 'remove quote, tab and between ampersand' With Selection.Find .Text = "^034^t^038^034" .Replacement.Text = "&" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll 'remove comma after tab' With Selection.Find .Text = "^t," .Replacement.Text = "^t" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll 'remove space after tab' With Selection.Find .Text = "^t " .Replacement.Text = "^t" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll 'replace periods with semi colons at end of each definition' With Selection.Find .Text = ".^p" .Replacement.Text = ";^p" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll Dim oRng As Range Const strText As String = "^13[A-Za-z]" Set oRng = ActiveDocument.Range With oRng.Find Do While .Execute(FindText:=strText, MatchWildcards:=True) 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 lbl_Exit: Set oRng = Nothing Exit Sub End Sub |
#3
|
||||
|
||||
Your macro does not convert the document to match the result example. They most obvious difference is the example doesn't use tabs whereas the macro inserts them. To get what you wanted and based solely on the provided examples, you need something like.
Code:
Sub DPU_convertdefinitions() Dim vFindText As Variant Dim vReplaceText As Variant Dim i As Integer vFindText = Array(Chr(34), Chr(9), Chr(32) & Chr(45), Chr(32) & Chr(44), Chr(32) & Chr(41), Chr(32) & Chr(38)) vReplaceText = Array("", " ", Chr(45), Chr(44), Chr(41), Chr(38)) For i = 0 To UBound(vFindText) Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = vFindText(i) .Replacement.Text = vReplaceText(i) .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False .Execute Replace:=wdReplaceAll End With DoEvents Next i End Sub
__________________
Graham Mayor - MS MVP (Word) (2002-2019) Visit my web site for more programming tips and ready made processes www.gmayor.com |
#4
|
|||
|
|||
Thank you so much for replying Graham. Sorry for the confusion but the test document was what the definitions look like before they are converted using the macro. The attached document (Doc 3) is how the definitions should look, i.e. the macro inserts quote marks, removes the word 'means' and puts a tab in, removes full stops at the end of each definition and inserts a semi-colon. My macro seems rather long and just wondered if it could be shortened. Also having an issue where a bold definition (with no quotes) appears in the actual text of the definition, the macro obviously converts that the same as the bold definitions at the beginning. Is there a way to ignore any bold words that are not at the beginning?
Doc 2 is what the definitions look like before converting Doc 3 is how the definitions should convert when running the macro 2. Test Document for definitions macro.docx 3. What the macro should do.docx Code:
Sub DPU_convertdefinitions() Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting ActiveDocument.Range.ListFormat.ConvertNumbersToText Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = """" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll 'replace tab with space' With Selection.Find .Text = "^t" .Replacement.Text = " " .Forward = True .Wrap = wdFindStop .Format = False .MatchCase = False .MatchWholeWord = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = True End With Selection.Find.Execute Replace:=wdReplaceAll Selection.Find.ClearFormatting Selection.Find.Font.Bold = True Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "<*>" .Replacement.Text = "^034^&^034^t" .Forward = True .Wrap = wdFindStop .Format = True .MatchCase = False .MatchWholeWord = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = True End With Selection.Find.Execute Replace:=wdReplaceAll 'tab after quote replace with space' With Selection.Find .Text = "^034^t ^034" .Replacement.Text = "^032" .Forward = True .Wrap = wdFindStop .Format = False .MatchCase = False .MatchWholeWord = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = True End With Selection.Find.Execute Replace:=wdReplaceAll 'remove space after tab' With Selection.Find .Text = "^t " .Replacement.Text = "^t" .Forward = True .Wrap = wdFindStop .Format = False .MatchCase = False .MatchWholeWord = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = True End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = "^p(" .Replacement.Text = "^p^t(" .Forward = True .Wrap = wdFindStop .Format = False .MatchCase = False .MatchWholeWord = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = False End With Selection.Find.Execute Replace:=wdReplaceAll 'remove the words means from each definition and insert a tab' With Selection.Find .Text = "^tmeans" .Replacement.Text = "^t" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll 'remove colon after tab' With Selection.Find .Text = "^t:" .Replacement.Text = "^t" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll 'remove tab and quotes before hyphen' With Selection.Find .Text = "^034^t^045^034" .Replacement.Text = "-" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll 'remove quote and tab before left bracket' With Selection.Find .Text = "^034^t^040^034" .Replacement.Text = " (" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll 'remove quote tab before right bracket' With Selection.Find .Text = "^034^t^041 ^034" .Replacement.Text = ") " .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll 'remove quote, tab and between ampersand' With Selection.Find .Text = "^034^t^038^034" .Replacement.Text = "&" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll 'remove comma after tab' With Selection.Find .Text = "^t," .Replacement.Text = "^t" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll 'remove space after tab' With Selection.Find .Text = "^t " .Replacement.Text = "^t" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll 'replace periods with semi colons at end of each definition' With Selection.Find .Text = ".^p" .Replacement.Text = ";^p" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll Dim oRng As Range Const strText As String = "^13[A-Za-z]" Set oRng = ActiveDocument.Range With oRng.Find Do While .Execute(FindText:=strText, MatchWildcards:=True) 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 lbl_Exit: Set oRng = Nothing Exit Sub End Sub |
Thread Tools | |
Display Modes | |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Macro to highlight unused definitions and undefined terms | Johnmajor | Word VBA | 20 | 02-18-2020 06:59 PM |
Spell check macro within macro button field doesn't work in one document | samuelle | Word VBA | 0 | 07-20-2016 02:27 AM |
Word Dictionary for Word 2007 - Molecular Biology definitions & videos | philpense | Word | 1 | 02-23-2015 04:34 PM |
How to update fields in all header definitions | ChrisBrewster | Word VBA | 2 | 02-10-2014 10:33 AM |
Problem: object library invalid or contains references to object definitions | aligahk06 | Office | 0 | 08-19-2010 12:29 PM |