View Single Post
Old 21st Oct 2005, 16:21   #11
Stewart
Once known as Blixa
takes it to extremes
 
Stewart's Avatar
 
Join Date: 26 May 2005
Location: Glasgow
Posts: 6,427
Send a message via MSN to Stewart
Default Re: Bk 19: The First Men in the Moon/The Sleeper Awakes - H.G. Wells

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.
  1. Open up a blank Word Document;
  2. Copy your chosen text into it.
  3. In the menu select Tools -> Macro -> Visual Basic Editor
  4. 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;
  5. Click once on This Document in the appropriate project i.e. the name of your Word document
  6. In the menu select Insert -> Module
  7. 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.
  8. Close the Visual Basic editor window and return to your document
  9. In the menu select Tools -> Macro -> Macros and select the new macro entitled FixMyDocument
  10. 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.
__________________
Reading: The Gourmet, Muriel Barberry | flickr | blog | world lit

Last edited by Stewart; 21st Oct 2005 at 16:29.
Stewart is offline   Reply With Quote