#1
|
|||
|
|||
VBA replace space with tab after bold text
Hi, I need to update the macro below as it currently isn't working correctly. I work with pdf converted to Word documents so formatting can be all over the place and not consistent. Currently the macro only works if there is already a tab after the bold definition text at the beginning of each sentence. If there is a space or colon tab or space colon space, the macro put all this text into column 1 which is incorrect. I'm looking for the macro to replace the space with a tab and also remove the colons from the bold definition text. Can anyone help me update this please. Many thanks.
Space to Tab 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 .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 |
#2
|
|||
|
|||
VBA replace space with tab after bold definition
I posted a few days ago but as yet not found a solution. Please can someone help. The macro will only work if there is already a tab after the last bold definition word at the beginning. I would just like to replace any spaces with tabs after the last bold definition word or ignore if one already exists. It is probably a really simple code but I've exhausted this forum looking for a solution and Google and nothing I am trying is working, I've just ended up making the code worse. If anyone can help I would be very grateful. Thanks, Shelley
|
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Find and Replace rows in a table based on bold text. | OfficeAssociate99 | Word VBA | 4 | 07-26-2017 07:20 AM |
Find and Replace rows in a table based on bold text. | OfficeAssociate99 | Word VBA | 2 | 07-26-2017 06:32 AM |
Find, select, and replace part of text with bold | paik1002 | Word VBA | 4 | 12-07-2015 11:24 PM |
Text in #1 is made bold, rest of the document is edited, text in #1 is now not bold | footer-assistance | Word | 1 | 06-29-2015 03:49 AM |
how to search and replace BOLD text >> font color change? | dylansmith | Word | 4 | 03-12-2013 09:51 PM |