Okay, have managed to do it. The code below may look like gobbledegook to most but it works and
that's the important thing.
It's not perfect, however, and some lines get merged but that's easily fixable manually.
- Open up a blank Word Document;
- Copy your chosen text into it.
- In the menu select Tools -> Macro -> Visual Basic Editor
- You should see the Project Explorer on the left of the screen. It's a tree-like hierarchy listing all the components of the session of Word. Documents, Projects, etc. If it's not there then press Crtl + R to bring it up;
- Click once on This Document in the appropriate project i.e. the name of your Word document
- In the menu select Insert -> Module
- You will be presented with a new module with the words Option Explixit at the top. Copy the code below into the module after Option Explicit. If Option Explicit is not there then write that at the top of the module.
- Close the Visual Basic editor window and return to your document
- In the menu select Tools -> Macro -> Macros and select the new macro entitled FixMyDocument
- Click the Run button and wait about ten seconds while it fixes your document.
Code:
Const cstrTitle1 As String = "Operation Failed"
Const cstrTitle2 As String = "Operation Successful"
Const cstrMessage1 As String = "Unable to populate search and replace terms."
Const cstrMessage2 As String = "Unable to perform search and replace operation."
Const cstrMessage3 As String = "Unable to correctly justify text."
Const cstrMessage4 As String = "The document has been successfully formatted."
Dim strSources(1 To 3) As String
Dim strReplaces(1 To 3) As String
Public Sub FixMyDocument()
Dim lngCounter As Long
' Populate arrays with values
If Not fGetValues Then
MsgBox cstrMessage1, vbExclamation, cstrTitle1
Exit Sub ' FixMyDocument
End If
' Perform search and replace three times
For lngCounter = 1 To 3
If Not fCorrectText(lngCounter) Then
MsgBox cstrMessage2, vbExclamation, cstrTitle1
Exit Sub ' FixMyDocument
End If
Next lngCounter
' Justify the text
If Not fJustifyText Then
MsgBox cstrMessage3, vbExclamation, cstrTitle1
Exit Sub ' FixMyDocument
End If
' Display success message
MsgBox cstrMessage4, vbExclamation, cstrTitle2
End Sub ' FixMyDocument
Private Function fGetValues() As Boolean
On Error GoTo Err_fGetValues
' Populate arrays for looping
strSources(1) = vbCr
strSources(2) = ".||"
strSources(3) = "||"
strReplaces(1) = "||"
strReplaces(2) = "." & vbCr & vbCr
strReplaces(3) = vbNullString
fGetValues = True ' Function was a success
Exit Function ' fGetValues
Err_fGetValues:
fGetValues = False ' Function failed
End Function ' fGetValues
Private Function fCorrectText(ByVal lngCounter As Long) As Boolean
On Error GoTo Err_fCorrectText
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = strSources(lngCounter)
.Replacement.Text = strReplaces(lngCounter)
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
fCorrectText = True
Exit Function ' fCorrectText
Err_fCorrectText:
fCorrectText = False
End Function ' fCorrectText
Private Function fJustifyText()
On Error GoTo Err_fJustifyText
Selection.WholeStory
Selection.ParagraphFormat.Alignment = wdAlignParagraphJustify
fJustifyText = True
Exit Function
Err_fJustifyText:
fJustifyText = False
End Function ' fJustifyText
I might look into developing this a little further as a Word add-in meaning that you can just "click" the code into place without knowing what you are doing and just select Fix Document, or whatever, from the Tools menu.