Word Formatting Macro (Stingo's Macro)

[Stingo]

Here is a Word Macro that was originally created by a member of the Librie group but which I modified a little. This macro removes hard page breaks, hard returns and adjusts the font to Times Roman 14. You can assign the macro to a function key for ease of access. Feel free to tweak to your needs.

'
' ebook_formatter Macro
' Macro created 11/28/2006
'
' This step take you to the top of your document

Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Name:="1"

' This step clears formatting and sets font to my preferred size
'
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
Selection.WholeStory
Selection.Font.Name = "Times New Roman"
Selection.Font.Size = 14
With Selection.Font
.NameFarEast = ""
.NameAscii = "Times New Roman"
.NameOther = "Times New Roman"
.Name = ""
.Size = 14
.Bold = False
.Italic = False
End With

' This step replaces hard page breaks
'
With Selection.Find
.Text = "^m"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

' This step replace the correct paragraph mark with a temporary sign "#*#", if your document has that sign, replace
' with some other special character
'
With Selection.Find
.Text = "^p^p"
.Replacement.Text = "#*#"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
' This step will replace the inappropriate line break with a space. Also see remark below
'
With Selection.Find
.Text = "^p"
.Replacement.Text = " " ' if there is a space at the end of the line, change this to ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
' This step will return the paragraph break to normal
'
With Selection.Find
.Text = "#*#"
.Replacement.Text = "^p^p"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

End Sub

[Bob Russell]

Thanks Stingo!

I don't know why I do this manually every time when a macro would be much more sensible. I'll try this one, or create another if I have any problems with it.

My only tweaks will probably be to full justify the text and to use 18pt font.

[HarryT]

Thanks for posting that, Stingo - it works extremely well.

The only change I've made, other the changing the font to my personal preference, is to add a final line:

Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Name:="1"

so that the cursor ends up at the top of the document, with no selection. Without it, the cursor is left at the bottom, with the entire document selected.

Extremely useful - very many thanks for that!

[Stingo]

Glad to help. Bob, I did not put in justify in order to preserved centered titles. Since the Macro is global justification would flush all centered titles to the left.

[TadW]

Nice work Stingo. Any hints how I can automatically load this Macro into Word?

[HarryT]

One easy way is to select "Tools/Macro/Record Macro", call it, say, "FormatEBook" and immediately click the "Stop" button to stop recording. That will give you an "empty" macro with the correct name. Now, select "Tools/Macro/Visual BASIC Editor" and simply copy and paste the macro into the body of the empty macro, then click the "Save" button on the VB editor to save it.

[reaganmike]

I just installed and used the macro. It worked great!

[Stingo]

Glad the macro is helping. If you relate the macro to a button on your tool bar it really becomes a pleasure to use.

I added a little section to take out double spaces that sometimes occur when there is a space at the end of the line prior to the hard return.

'
' ebook_formatter Macro
' Macro created 11/28/2006 by Jorge Espinosa
'
' This step take you to the top of your document

Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Name:="1"

' This step clears formatting and sets font to my preferred size
'
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
Selection.WholeStory
Selection.Font.Name = "Times New Roman"
Selection.Font.Size = 14
With Selection.Font
.NameFarEast = ""
.NameAscii = "Times New Roman"
.NameOther = "Times New Roman"
.Name = ""
.Size = 14
.Bold = False
.Italic = False
End With

' This step replaces hard page breaks
'
With Selection.Find
.Text = "^m"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

' This step replace the correct paragraph mark with a temporary sign "#*#", if your document has that sign, replace
' with some other special character
'
With Selection.Find
.Text = "^p^p"
.Replacement.Text = "#*#"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

' This step will replace the inappropriate line break with a space.
'
With Selection.Find
.Text = "^p"
.Replacement.Text = " "
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

' This step will replace the double spaces sometimes created by previous replace.
'
With Selection.Find
.Text = " "
.Replacement.Text = " " ' if there is a space at the end of the line, change this to ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

' This step will return the paragraph break to normal
'
With Selection.Find
.Text = "#*#"
.Replacement.Text = "^p^p"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

[RWood]

Great work Stingo. My knowledge of VB is limited (COBOL or FORTRAN is more my speed.) Is there a loop control structure that you could add around the double space removal section that would repeat until zero (0) occurances were changes. Many of the poorly formatted documents I have to deal with will have sometimes three or four or more spaces between words.

[Stingo]

Sure is but it probably should be put in a separate macro. I'll write one in the next couple of days. I was also toying with the idea of putting in a pop-up window to input the title and author but I haven't gotten around to it.

[Bob Russell]

Couldn't you just run the same macro repeatedly?

[svr]

Rwood,
Try this Macro for deleting multiple spaces.
There is a space between the [] brackets in the .TExt parameter. The numbers between the curly braces indicate how many spaces you want to look for, in this case I am searching or a minimum of 2 spaces upto a maximum of 6, you can make it as many as you want. But leave the minimum at 2, otherwise you will have one massive word!!


Sub DeleteMultipleSpaces()
'
' DeleteMultipleSpaces Macro

'
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "([ ]{2,6})"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub

[RWood]

svr: Thanks. I needed to make one change to the macro:

.Replacement.Text = " "

I added a space for the replacement text as otherwise it ran the words together when it executed. I also grafted it to the end of Stingo's macro to perform all editing/formatting in one step.

Thanks to both of you.

[Stingo]

Good addition SVR. Rwood, you may still not want to put it at the end of my macro since there may be cases where it destroys formatting that you want to preserve. Julio Cortazar's E-book Rayuela is one example where this is the case.

It occurred to me that we need to play the switch game again if we are going to preserve two spaces after the period so you would want to do the following.

Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = ". "
.Replacement.Text = "#!#"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With

With Selection.Find
.Text = "([ ]{2,6})"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

With Selection.Find
.Text = "#!#"
.Replacement.Text = ". "
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With

[RWood]

For me, two spaces at the end of a sentance is a hold over from the days of the typewriter and mono spaced fonts. Even if you format flush left, I feel that two spaces after a sentance produces gaps in a paragraph. On paper and on screen I find single spaces at the end of a sentance more pleasing and more readable.