Microsoft Office Forums

Go Back   Microsoft Office Forums > >

 
 
Thread Tools Display Modes
Prev Previous Post   Next Post Next
  #1  
Old 06-15-2021, 01:56 AM
Shelley Lou Shelley Lou is offline VBA quote mark to insert after square bracket Windows 10 VBA quote mark to insert after square bracket Office 2016
Expert
VBA quote mark to insert after square bracket
 
Join Date: Dec 2020
Posts: 259
Shelley Lou is on a distinguished road
Default 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
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 09:09 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