#1
|
|||
|
|||
VBA semi colon at end of sentences
Hi, I have got the macro below to insert semi-colons at the end of a sentence. I'm looking to exclude certain words at the end of sentence i.e 'and, but and or' as these belong to lists which already have a semi-colon before each of these words. How can I exclude these in the code. Thanks
Code:
Sub DPU_Test() Application.ScreenUpdating = False Dim Para As Paragraph Dim oRng As Range Set oRng = ActiveDocument.Range With oRng.Find .Text = ".^p" .Replacement.Text = "^p" .Execute Replace:=wdReplaceAll End With On Error Resume Next For Each Para In ActiveDocument.Paragraphs With Para.Range If Len(.Text) > 2 Then If Not .Characters.Last.Previous Like "[.!?:;]" Then .Characters.Last.InsertBefore ";" End If End If End With Next Application.ScreenUpdating = True End Sub |
#2
|
||||
|
||||
Try this
Code:
Sub DPU_Test2() 'Application.ScreenUpdating = False Dim Para As Paragraph, oRng As Range Set oRng = ActiveDocument.Range With oRng.Find .Text = ".^p" .Replacement.Text = "^p" .Execute Replace:=wdReplaceAll End With On Error Resume Next 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 'Application.ScreenUpdating = True End Sub
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
#3
|
|||
|
|||
VBA semi-colon at end of sentence
Many thanks Andrew for your kind assistance, this has worked perfectly and has saved me a lot of amending time with large documents, can't thank you enough.
|
#4
|
|||
|
|||
Updated VBA semi-colon at end of sentence
Hi, I've inserted Andrew's updated macro for semi-colons into the macro below which works when run on its own. I've added it to the below macro, it runs with no errors but the insert semi-colon doesn't seem to be working within this macro. I've tried inserting it in various places but nothing seems to be working and I'm a bit stumped as to why. If anyone can help I would be most grateful. Thanks
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 On Error Resume Next 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 '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 |
#5
|
||||
|
||||
You've gone straight to
With Para.Range Without telling Word what Para is Where is the loop For Each Para In ActiveDocument.Paragraphs ... Next Para And get rid of the On Error Resume Next so it is easier to debug.
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
#6
|
|||
|
|||
VBA semi-colon at end of sentence
Thank you Andrew, not sure what happened there as I copied the code in your post as is, seems to be working ok now. Many thanks for your help
|
Thread Tools | |
Display Modes | |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Image semi-disappearing behind text lines | Ulodesk | Drawing and Graphics | 3 | 01-28-2019 12:50 PM |
Word is reverting my formatting semi-randomly after a third-party program removes sections | Alsadius | Word | 4 | 11-27-2017 08:46 AM |
Work semi completed | c991257 | Project | 11 | 05-11-2016 04:13 AM |
aligning colon | JRaul | Word | 4 | 07-07-2012 06:06 AM |
Semi-flexible templates (couple of questions) | mshanks | Word | 1 | 07-29-2009 06:35 AM |