Microsoft Office Forums

Go Back   Microsoft Office Forums > >

 
 
Thread Tools Display Modes
Prev Previous Post   Next Post Next
  #11  
Old 06-20-2021, 05:48 AM
Guessed's Avatar
Guessed Guessed is offline VBA quote mark to insert after square bracket Windows 10 VBA quote mark to insert after square bracket Office 2016
Expert
 
Join Date: Mar 2010
Location: Canberra/Melbourne Australia
Posts: 4,185
Guessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant future
Default

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
Reply With Quote
 



Similar Threads
Thread Thread Starter Forum Replies Last Post
Insert Block Quote into Numbered List krose4088 Word 4 12-10-2020 02:29 PM
VBA quote mark to insert after square bracket Delete blank paragraph below bold, end square bracket Dave T Word VBA 2 04-28-2019 11:00 PM
VBA quote mark to insert after square bracket 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
VBA quote mark to insert after square bracket Insert caption to graphic with square text wrapping nothing_kills Drawing and Graphics 7 01-20-2014 10:57 PM

Other Forums: Access Forums

All times are GMT -7. The time now is 03:24 PM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2025, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2025 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft