I got tired of going through the properties menu to fill in the the title and author information in converted files so I modified the Word macro to pop up a window at the start which lets you fill the information in. The window is non-modal so you can cut and paste the author and title from the document.
Download the zip file, expand the two files in its contents. Open word, open macros. Select the old macro or if you have never installed this macro before follow instructions elsewhere on this thread. Edit the macro. Drag and drop the two files in the sip unto the forms item in the macro window. Cut and paste the macro text below.
Sub ebook_formatter()
'
' 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"
' Author Title Box
'
title_author_form.Titlebox = ActiveDocument.BuiltInDocumentProperties("Title"). Value
title_author_form.Authorbox = ActiveDocument.BuiltInDocumentProperties("Author") .Value
title_author_form.Show
' 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
End Sub
|