![]() |
|
|
|
#1
|
||||
|
||||
|
Without seeing some sample content, it's hard to know exactly what needs to be done. Try:
Code:
Sub Demo()
Application.ScreenUpdating = False
With ActiveDocument.Range
With .Find
.Wrap = wdFindStop
.MatchWildcards = True
.Text = "[! ^13]@[!.\!\?:;]^13"
.Replacement.Text = ""
.Execute
End With
Do While .Find.Found = True
Select Case Trim(.Words.First)
Case "and", "but", "or", "then"
'do nothing
Case Else
.Words.First.InsertAfter ";"
End Select
.Collapse wdCollapseEnd
.Find.Execute
Loop
End With
Application.ScreenUpdating = True
End Sub
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
|
#2
|
|||
|
|||
|
Hi Macropod, many thanks for the code. I'm having an error with 'Do While.Find.Found = True' - error says 'Method or data member not found'. I have inserted the full code I'm trying to get it to work in after your code.
Definition Test Doc.docx Code:
'Remove punctuation and insert semi-colon at end of sentence
Set orng = ActiveDocument.Range
With orng.Find
.Wrap = wdFindStop
.MatchWildcards = True
.Text = "[! ^13]@[!.\!\?:;]^13"
.Replacement.Text = ""
.Execute Replace:=wdReplaceAll
End With
Do While .Find.Found = True
Select Case Trim(.Words.First)
Case "and", "but", "or", "then"
'do nothing
Case Else
.Words.First.InsertAfter ";"
End Select
.Collapse wdCollapseEnd
.Find.Execute
Loop
End With
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
'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
With orng.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "[:;, ^t]{1,5}means[:;, ]{1,5}"
.Replacement.Text = "^t"
.Replacement.Font.Bold = False
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
.Execute Replace:=wdReplaceAll
With orng.Find
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"
.Replacement.Font.Bold = False
.MatchWildcards = True
.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.Characters.Last = vbTab
orng.Font.Bold = False
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
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
'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 punctuation and insert semi-colon at end of sentence
Set orng = ActiveDocument.Range
With orng.Find
.Wrap = wdFindStop
.MatchWildcards = True
.Text = "[! ^13]@[!.\!\?:;]^13"
.Replacement.Text = ""
.Execute Replace:=wdReplaceAll
End With
Do While .Find.Found = True
Select Case Trim(.Words.First)
Case "and", "but", "or", "then"
'do nothing
Case Else
.Words.First.InsertAfter ";"
End Select
.Collapse wdCollapseEnd
.Find.Execute
Loop
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 With
End With
End Sub
|
|
|
|
Similar Threads
|
||||
| Thread | Thread Starter | Forum | Replies | Last Post |
How to delete all the punctuation marks from a paragraph?
|
Jamal NUMAN | Word | 3 | 02-26-2019 02:33 PM |
punctuation order
|
fariz | Word | 2 | 10-31-2016 12:57 AM |
Need help with modifying a replacing font VBA code- similar task but subtle change
|
kissingfrogs2003 | Word VBA | 3 | 08-30-2016 11:42 AM |
| Replacing punctuation marks with footnotes | nufc89 | Word | 2 | 05-22-2015 03:15 PM |
| Punctuation | lexsper | Word | 0 | 04-06-2015 07:26 AM |