#1
|
|||
|
|||
VBA quote mark to insert after square bracket
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 |
#2
|
|||
|
|||
VBA quote mark after square bracket in definitions
Hi posted yesterday, is anyone able to help identify how to make VBA insert the quote mark after the square bracket as I can't seem to get it to work. Many thanks
|
#3
|
||||
|
||||
Based on your example make a wildcard search for
(\))?(\]) replace with \1\2 you might find https://www.gmayor.com/document_batch_processes.htm useful -especially the replace from table list option
__________________
Graham Mayor - MS MVP (Word) (2002-2019) Visit my web site for more programming tips and ready made processes www.gmayor.com |
#4
|
|||
|
|||
VBA quote mark to insert after square bracket
Where should I insert this in the VBA? Bit confused as nothing is working
|
#5
|
|||
|
|||
I have identified that this is the part of the code that inserts bold quotes around the main bold definition text at the beginning. Can someone help me with the code so that if the definition starts with a square bracket that the quote inserts after the square bracket and not before (see doc at beginning of post). I've tried Graham's search and replace but it doesn't seem to work. Thanks
Code:
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 |
#6
|
||||
|
||||
Shelley Lou
This code is getting more and more complex and will result in a document that is less and less well formatted. I think we need to get back to first principles for this task and use styles (paragraph and character) to format this. Can you post a Before and After example showing ALL the possible variations you need the macro to deal with. If we can see what you want to achieve, it is easier to code from scratch than it is to fiddle with individual components in your find and replace series.
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
#7
|
|||
|
|||
VBA quote mark to insert after square bracket
Hi, many thanks for replying it is very much appreciated. Background is I house style documents, converted from pdf to word mostly, I copy the definitions part into a blank document then run the macro. Once I've checked for errors I run another macro that converts text to correct styles and inserts 2 column table, hence the tabs before non-bold sentences. I have attached a copy of the table document also. There is an issue where the definition starts with a), b) and not (a), (b). House style is Arial 10, 0pt before, 9pt after, line spacing At Least 15. I've tried to comment as much as possible in the BEFORE MACRO IS RUN document. Thank you for looking at this.
BEFORE MACRO IS RUN definitions test 1.docx AFTER MACRO IS RUN definitions test 2.docx CONVERTED TO TABLE FORMAT definitions test 3.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 and add double quotes' .Text = ":""" .Replacement.Text = """" .Execute Replace:=wdReplaceAll End With With orng.Find 'remove bold from spaces after athe word means .Text = "means " .Replacement.Text = "means " .Replacement.Font.Bold = True .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 '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.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 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 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 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 Code:
Sub DPU_TextToTables() Dim oBorder As Border Dim Para As Paragraph Selection.WholeStory Selection.ConvertToTable Separator:=wdSeparateByTabs, NumColumns:=2, _ NumRows:=8, AutoFitBehavior:=wdAutoFitFixed With Selection.Tables(1) .Style = "Table Grid" .ApplyStyleHeadingRows = True .ApplyStyleLastRow = False .ApplyStyleFirstColumn = True .ApplyStyleLastColumn = False With .Range .Font.Name = "Arial" .Font.Size = 10 With .ParagraphFormat .SpaceBefore = 0 .SpaceBeforeAuto = False .SpaceAfter = 9 .SpaceAfterAuto = False .LineSpacingRule = wdLineSpaceAtLeast .LineSpacing = 15 .LineUnitBefore = 0 .LineUnitAfter = 0 End With End With With .Columns(1) .PreferredWidth = InchesToPoints(2.7) .Select With Selection.ParagraphFormat .Alignment = wdAlignParagraphLeft .LeftIndent = InchesToPoints(1) .Style = "DefBold" End With For Each oBorder In .Borders oBorder.LineStyle = wdLineStyleNone Next oBorder End With With .Columns(2) .Select With Selection.ParagraphFormat .Alignment = wdAlignParagraphJustify End With .PreferredWidth = InchesToPoints(3.63) For Each oBorder In .Borders oBorder.LineStyle = wdLineStyleNone Next oBorder End With Call DPU_ApplyHeadingStylesToTableTable End With End Sub |
#8
|
||||
|
||||
I didn't fiddle with the semi colon endings because your very first 'fixed' paragraph broke the rule of [sentences to end with a semi-colon]. - so it wasn't particularly clear what you wanted there. This code assumes your table formatting is done by the Table Style definitions. I've attached a result document with table style defined to match your look.
Code:
Sub DefinitionsTabulator() Dim aRng As Range, aTbl As Table, aPara As Paragraph, aCell As Cell Set aRng = ActiveDocument.Range For Each aPara In aRng.Paragraphs aPara.Range.Words.Last.Font.Reset 'remove bold from paragraph marks and autonumbers Next aPara With aRng.Find .ClearFormatting .Replacement.ClearFormatting .Text = "[:;, ^t]{1,5}means[:;, ]{1,5}" .Replacement.Text = "^t" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = True .Execute Replace:=wdReplaceAll .Text = "[ :]{1,5}^13" .Replacement.Text = ":^p" .Execute Replace:=wdReplaceAll Set aRng = ActiveDocument.Range aRng.ListFormat.ConvertNumbersToText .Text = "^13([a-z])\)" .Replacement.Text = "^13(\1)" .Execute Replace:=wdReplaceAll .Text = "^13(?)" .Replacement.Text = "|\1" .MatchWildcards = True .Font.Bold = False .Execute Replace:=wdReplaceAll .Text = "(?)^t" .Replacement.Text = "\1zzTabzz" .Font.Bold = False .Execute Replace:=wdReplaceAll End With Set aRng = ActiveDocument.Range Set aTbl = aRng.ConvertToTable(Separator:=wdSeparateByTabs, NumColumns:=2, AutoFitBehavior:=wdAutoFitFixed) With aTbl .Style = "Table Grid Light" 'choose a table style that matches your preferred table look .ApplyStyleHeadingRows = False .ApplyStyleLastRow = False .ApplyStyleFirstColumn = True 'make sure the table style has a bold first column .ApplyStyleLastColumn = False .Range.Style = wdStyleNormal For Each aCell In .Columns(1).Cells If aCell.Range.Characters.First = "[" Then aCell.Range.Characters.First.InsertAfter Text:="""" aCell.Range.Characters.Last.InsertBefore Text:="""" Else aCell.Range.Characters.First.InsertBefore Text:="""" aCell.Range.Characters.Last.InsertBefore Text:="""" End If Next aCell End With 'Reinstate the tabs and paragraphs With aRng.Find .ClearFormatting .Replacement.ClearFormatting .MatchWildcards = False .Text = "|" .Replacement.Text = "^p" .Execute Replace:=wdReplaceAll .Text = "zzTabzz" .Replacement.Text = "^t" 'or a space if you prefer .Execute Replace:=wdReplaceAll End With End Sub
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
#9
|
|||
|
|||
VBA quote mark after square bracket in definitions
Hi Andrew, thanks for looking at this much appreciated. Just looking through the first part, after wording 'remove bold from paragraph marks and autonumbers what do the functions do as I would like to put in comments to remind me what the functions are, will have a test of some docs see how it works
|
#10
|
|||
|
|||
VBA quote mark to insert after square bracket
Hi Andrew, I've run the macro but there are some issues. I've attached a word doc showing these. For each sub-para e.g. (a), (i), (A), (1) these need to be in their own row individually. Not sure where I should be applying the column styles. For column 1 it will be "DefBold" and column 2 will be 'Definition Level 1'. Also for formatting the table for column width, no border etc. as in my table macro, I've inserted in various spaces but nothing seems to work.
VBA Defs doc.docx |
#11
|
||||
|
||||
I think it is a bad idea to put the sub-paras in different rows. However, I've added that in as an option line so you can choose to have it. I've also tinkered to size the columns and add some comments. The square brackets on the ends of lines fail to find when they are formfield results - are the formfields just something you added for markup reasons or are they in your real documents?
Code:
Sub DefinitionsTabulator() Dim aRng As Range, aTbl As Table, aPara As Paragraph, aCell As Cell Set aRng = ActiveDocument.Range For Each aPara In aRng.Paragraphs aPara.Range.Words.Last.Font.Reset 'remove bold from paragraph marks and autonumbers Next aPara With aRng.Find .ClearFormatting .Replacement.ClearFormatting .Text = "[:;, ^t]{1,5}means[:;, ]{1,5}" 'replace means with a tab .Replacement.Text = "^t" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = True .Execute Replace:=wdReplaceAll .Text = "[ ]{2,9}" 'multiple spaces reduced to one .Replacement.Text = " " .Execute Replace:=wdReplaceAll Set aRng = ActiveDocument.Range aRng.ListFormat.ConvertNumbersToText 'make lists hard coded .Text = "^w^p" 'paragraphs ending with whitespace have spaces removed .Replacement.Text = "^p" .MatchWildcards = False .Execute Replace:=wdReplaceAll .Text = "]^p" 'paragraphs ending with ], add semi-colon in front of ] .Replacement.Text = ";]^p" .Execute Replace:=wdReplaceAll .Text = " ([;:,]{1,5})" 'space before punctuation removed .Replacement.Text = "\1" .MatchWildcards = True .Execute Replace:=wdReplaceAll .Text = "^13([a-z])\)" 'make sure lists with unopened brackets a) get opening bracket (a) .Replacement.Text = "^13(\1)" .Execute Replace:=wdReplaceAll .Text = "^13(?)" 'If paragraph starts non-bold '.Replacement.Text = "|\1" 'Option: keep all paragraphs in a definition in one row .Replacement.Text = "^p^t\1" 'Option: if you want separate rows per paragraph .MatchWildcards = True .Font.Bold = False .Execute Replace:=wdReplaceAll .Text = "([!^13])^t" 'find tabs preceded by non-bold character other than a carriage return .Replacement.Text = "\1zzTabzz" 'replace with a replaceable unique string .Font.Bold = False .Execute Replace:=wdReplaceAll End With Set aRng = ActiveDocument.Range Set aTbl = aRng.ConvertToTable(Separator:=wdSeparateByTabs, NumColumns:=2, AutoFitBehavior:=wdAutoFitFixed) With aTbl .Style = "Table Grid Light" 'choose a table style that matches your preferred table look .ApplyStyleHeadingRows = False .ApplyStyleLastRow = False .ApplyStyleFirstColumn = True 'make sure the table style has a bold first column .ApplyStyleLastColumn = False .ApplyStyleRowBands = False .Range.Style = "Definition Level 1" For Each aCell In .Columns(1).Cells aCell.Range.Style = "DefBold" If aCell.Range.Characters.First = "[" Then aCell.Range.Characters.First.InsertAfter Text:="""" aCell.Range.Characters.Last.InsertBefore Text:="""" ElseIf Len(aCell.Range.Text) > 2 Then aCell.Range.Characters.First.InsertBefore Text:="""" aCell.Range.Characters.Last.InsertBefore Text:="""" End If Next aCell .Columns.PreferredWidthType = wdPreferredWidthPoints .Columns.PreferredWidth = InchesToPoints(2.7) .Columns(2).PreferredWidth = InchesToPoints(3.63) End With 'Reinstate the tabs and paragraphs With aRng.Find .ClearFormatting .Replacement.ClearFormatting .MatchWildcards = False .Text = "|" .Replacement.Text = "^p" .Execute Replace:=wdReplaceAll .Text = "zzTabzz" .Replacement.Text = "^t" 'or a space if you prefer .Execute Replace:=wdReplaceAll End With 'Remove all local formatting ActiveDocument.Range.Font.Reset End Sub
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
#12
|
|||
|
|||
VBA quote mark to insert after square bracket
Hi Andrew, many thanks for this revised code, this is really start to take shape now. I have also inserted some code for the table to have no border. Our house style requires the separate rows so many thanks for that coding it works. I have a further macro that updates (a), (A) etc. to the correct auto number style which will be called at the end of this macro.
House style requires square brackets to be in form fields which is an action I usually perform right at the end of converting so not needed for this macro. I've run the macro several times and it seems the only command left to perform is to delete any periods at the end of sentences in column 2 and replace with a semi-colon, or where punctuation is missing at the end of the sentence to insert a semi-colon (except where there are colons) except for the words 'and', 'or', 'but', 'then'. Any ideas how I can insert this into the code? |
#13
|
|||
|
|||
VBA quote mark to insert after square bracket
Hi Andrew, I've been running the code on some test documents and I've come across a couple of issues that the macro isn't picking up.
1. After the Bold Definition text, if there is a bold space and not a tab the macro puts the whole definition into column 1. 2. If the Bold Definition text is on a line on its own and sub-levels (a), (b) etc. are on the next line the macro doesn't pick this up and puts (a) into column 1. 3. If the word 'means' appears additionally in the sentence the macro is deleting the word and inserting a tab, e.g. in relation to any group company means any other company Is there something we could add to the code to stop this happening? Thanks, Shelley Before Macro TEST DOC.docx After Macro TEST DOC.docx Code:
Sub DPU_DefinitionTabulator() Dim aRng As Range, aTbl As Table, aPara As Paragraph, aCell As Cell, oBorder As Border Set aRng = ActiveDocument.Range For Each aPara In aRng.Paragraphs aPara.Range.Words.Last.Font.Reset 'remove bold from paragraph marks and autonumbers Next aPara With aRng.Find .ClearFormatting .Replacement.ClearFormatting .Text = "[:;, ^t]{1,5}means[:;, ]{1,5}" 'replace means with a tab .Replacement.Text = "^t" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = True .Execute Replace:=wdReplaceAll .Text = "[ ]{2,9}" 'multiple spaces reduced to one .Replacement.Text = " " .Execute Replace:=wdReplaceAll Set aRng = ActiveDocument.Range aRng.ListFormat.ConvertNumbersToText 'make lists hard coded .Text = "^w^p" 'paragraphs ending with whitespace have spaces removed .Replacement.Text = "^p" .MatchWildcards = False .Execute Replace:=wdReplaceAll .Text = ".^p" 'paragraphs ending with ], add semi-colon in front of ] .Replacement.Text = ";^p" .Execute Replace:=wdReplaceAll .Text = ".]^p" 'paragraphs ending with ], add semi-colon in front of ] .Replacement.Text = ";]^p" .Execute Replace:=wdReplaceAll .Text = " ([;:,]{1,5})" 'space before punctuation removed .Replacement.Text = "\1" .MatchWildcards = True .Execute Replace:=wdReplaceAll .Text = "^13([a-z])\)" 'make sure lists with unopened brackets a) get opening bracket (a) .Replacement.Text = "^13(\1)" .Execute Replace:=wdReplaceAll .Text = "^13(?)" 'If paragraph starts non-bold '.Replacement.Text = "|\1" 'Option: keep all paragraphs in a definition in one row .Replacement.Text = "^p^t\1" 'Option: if you want separate rows per paragraph .MatchWildcards = True .Font.Bold = False .Execute Replace:=wdReplaceAll .Text = "([!^13])^t" 'find tabs preceded by non-bold character other than a carriage return .Replacement.Text = "\1zzTabzz" 'replace with a replaceable unique string .Font.Bold = False .Execute Replace:=wdReplaceAll End With Set aRng = ActiveDocument.Range Set aTbl = aRng.ConvertToTable(Separator:=wdSeparateByTabs, NumColumns:=2, AutoFitBehavior:=wdAutoFitFixed) With aTbl .Style = "Table Grid Light" 'choose a table style that matches your preferred table look .ApplyStyleHeadingRows = False .ApplyStyleLastRow = False .ApplyStyleFirstColumn = True 'make sure the table style has a bold first column .ApplyStyleLastColumn = False .ApplyStyleRowBands = False .Range.Style = "Definition Level 1" For Each aCell In .Columns(1).Cells aCell.Range.Style = "DefBold" If aCell.Range.Characters.First = "[" Then aCell.Range.Characters.First.InsertAfter Text:="""" aCell.Range.Characters.Last.InsertBefore Text:="""" ElseIf Len(aCell.Range.Text) > 2 Then aCell.Range.Characters.First.InsertBefore Text:="""" aCell.Range.Characters.Last.InsertBefore Text:="""" End If Next aCell .Columns.PreferredWidthType = wdPreferredWidthPoints .Columns.PreferredWidth = InchesToPoints(2.7) .Columns(2).PreferredWidth = InchesToPoints(3.63) For Each oBorder In .Borders oBorder.LineStyle = wdLineStyleNone Next oBorder End With 'Reinstate the tabs and paragraphs With aRng.Find .ClearFormatting .Replacement.ClearFormatting .MatchWildcards = False .Text = "|" .Replacement.Text = "^p" .Execute Replace:=wdReplaceAll .Text = "zzTabzz" .Replacement.Text = "^t" 'or a space if you prefer .Execute Replace:=wdReplaceAll End With 'Remove all local formatting ActiveDocument.Range.Font.Reset Call DPU_ApplyHeadingStylesToTableTable End Sub Code:
Sub DPU_ApplyHeadingStylesToTableTable() Application.ScreenUpdating = False Dim r As Long, i As Long With ActiveDocument.Tables(1) For r = 1 To .Rows.Count With .Cell(r, 2).Range If .Characters.First <> "(" Then .Style = "Definition Level 1" Else i = Asc(Split(Split(.Text, "(")(1), ")")(0)) Select Case i Case 97 To 104, 106 To 117, 119, 121 To 122: .Style = "Definition Level 2" 'LowercaseLetter Case 105, 118, 120: .Style = "Definition Level 3" 'LowercaseRoman Case 65 To 90: .Style = "Definition Level 4" 'UppercaseLetter Case 48 To 57: .Style = "Definition Level 5" 'Arabic End Select .Collapse wdCollapseStart .MoveEndUntil " " .End = .End + 1 .Delete End If End With Next End With |
#14
|
|||
|
|||
UPDATED VBA quote mark to insert after square bracket
I'm posting again in the hope I can resolve a couple of issues with the macro below.
Before Macro TEST DOC.docx After Macro TEST DOC.docx 1. When converting pdfs to word, the definitions may or may not contain the word 'means' after the main bold definition text at the start of the sentence. The macro currently only looks for the word 'means' and deletes and inserts a tab. What I would like is if after the bold text and it is just a space and/or colon space without the word 'means' that the space and/or colon space is replaced with a tab otherwise the whole definition ends up in column 1. 2. If the word 'means' appears additionally in the sentence the macro is deleting the word and inserting a tab, e.g. in relation to any group company means any other company (see attached documents). Is there something I could add to the code below to prevent this from happening? Code:
With aRng.Find .ClearFormatting .Replacement.ClearFormatting .Text = "[:;, ^t]{1,5}means[:;, ]{1,5}" 'replace means with a tab .Replacement.Text = "^t" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = True .Execute Replace:=wdReplaceAll This is the whole macro: Code:
Sub DPU_DefinitionTabulator() Dim aRng As Range, aTbl As Table, aPara As Paragraph, aCell As Cell, oBorder As Border Set aRng = ActiveDocument.Range For Each aPara In aRng.Paragraphs aPara.Range.Words.Last.Font.Reset 'remove bold from paragraph marks and autonumbers Next aPara With aRng.Find .ClearFormatting .Replacement.ClearFormatting .Text = "[:;, ^t]{1,5}means[:;, ]{1,5}" 'replace means with a tab .Replacement.Text = "^t" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = True .Execute Replace:=wdReplaceAll .Text = "[ ]{2,9}" 'multiple spaces reduced to one .Replacement.Text = " " .Execute Replace:=wdReplaceAll Set aRng = ActiveDocument.Range aRng.ListFormat.ConvertNumbersToText 'make lists hard coded .Text = "^w^p" 'paragraphs ending with whitespace have spaces removed .Replacement.Text = "^p" .MatchWildcards = False .Execute Replace:=wdReplaceAll .Text = ".^p" 'paragraphs ending with . add semi-colon .Replacement.Text = ";^p" .Execute Replace:=wdReplaceAll .Text = ".]^p" 'paragraphs ending with ] add semi-colon in front of ] .Replacement.Text = ";]^p" .Execute Replace:=wdReplaceAll .Text = " ([;:,]{1,5})" 'space before punctuation removed .Replacement.Text = "\1" .MatchWildcards = True .Execute Replace:=wdReplaceAll .Text = "^13([a-z])\)" 'make sure lists with unopened brackets a) get opening bracket (a) .Replacement.Text = "^13(\1)" .Execute Replace:=wdReplaceAll .Text = "^13(?)" 'If paragraph starts non-bold '.Replacement.Text = "|\1" 'Option: keep all paragraphs in a definition in one row .Replacement.Text = "^p^t\1" 'Option: if you want separate rows per paragraph .MatchWildcards = True .Font.Bold = False .Execute Replace:=wdReplaceAll .Text = "([!^13])^t" 'find tabs preceded by non-bold character other than a carriage return .Replacement.Text = "\1zzTabzz" 'replace with a replaceable unique string .Font.Bold = False .Execute Replace:=wdReplaceAll End With Set aRng = ActiveDocument.Range Set aTbl = aRng.ConvertToTable(Separator:=wdSeparateByTabs, NumColumns:=2, AutoFitBehavior:=wdAutoFitFixed) With aTbl .Style = "Table Grid Light" 'choose a table style that matches your preferred table look .ApplyStyleHeadingRows = False .ApplyStyleLastRow = False .ApplyStyleFirstColumn = True 'make sure the table style has a bold first column .ApplyStyleLastColumn = False .ApplyStyleRowBands = False .Range.Style = "Definition Level 1" For Each aCell In .Columns(1).Cells aCell.Range.Style = "DefBold" If aCell.Range.Characters.First = "[" Then aCell.Range.Characters.First.InsertAfter Text:="""" aCell.Range.Characters.Last.InsertBefore Text:="""" ElseIf Len(aCell.Range.Text) > 2 Then aCell.Range.Characters.First.InsertBefore Text:="""" aCell.Range.Characters.Last.InsertBefore Text:="""" End If Next aCell .Columns.PreferredWidthType = wdPreferredWidthPoints .Columns.PreferredWidth = InchesToPoints(2.7) .Columns(2).PreferredWidth = InchesToPoints(3.63) For Each oBorder In .Borders oBorder.LineStyle = wdLineStyleNone Next oBorder End With 'Reinstate the tabs and paragraphs With aRng.Find .ClearFormatting .Replacement.ClearFormatting .MatchWildcards = False .Text = "|" .Replacement.Text = "^p" .Execute Replace:=wdReplaceAll .Text = "zzTabzz" .Replacement.Text = "^t" 'or a space if you prefer .Execute Replace:=wdReplaceAll End With 'Remove all local formatting ActiveDocument.Range.Font.Reset 'Call DPU_ApplyHeadingStylesToTableTable End Sub |
Thread Tools | |
Display Modes | |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Insert Block Quote into Numbered List | krose4088 | Word | 4 | 12-10-2020 02:29 PM |
Delete blank paragraph below bold, end square bracket | Dave T | Word VBA | 2 | 04-28-2019 11:00 PM |
Remove repeated number after square bracket | 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 |
Insert caption to graphic with square text wrapping | nothing_kills | Drawing and Graphics | 7 | 01-20-2014 10:57 PM |