Writer&';s Friend


by Dale Stubbart

WrF_CreateSpace_Format

Donate here

Sub WrF_CreateSpace_Format()
' Optionally Set Author
Dim WrF_Author As String:WrF_Author = ""
' File.Options.Save.PreserveFidelityWhenSharing.EmbedTrueTypeFonts
ActiveDocument.EmbedTrueTypeFonts = True
' Go to Header
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
' Reset Tabs
Selection.ParagraphFormat.TabStops.ClearAll
ActiveDocument.DefaultTabStop = InchesToPoints(0.5)
Selection.ParagraphFormat.TabStops.Add Position:=InchesToPoints(4), Alignment:=wdAlignTabRight, Leader:=wdTabLeaderSpaces
Selection.TypeText Text:=Left(ActiveDocument.Name, InStrRev(ActiveDocument.Name, ".") - 1)
Selection.HomeKey Unit:=wdLine, Extend:=wdExtend
Selection.Style = ActiveDocument.Styles("Title")
' Go to Footer
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter
' Reset Tabs
Selection.ParagraphFormat.TabStops.ClearAll
ActiveDocument.DefaultTabStop = InchesToPoints(0.5)
Selection.ParagraphFormat.TabStops.Add Position:=InchesToPoints(4), Alignment:=wdAlignTabRight, Leader:=wdTabLeaderSpaces
' Insert Author
If WrF_Author = "" Then
WrF_Author = InputBox("Author", , StrConv(ActiveDocument.BuiltInDocumentProperties("Author"), vbProperCase))
End If
Selection.TypeText Text:=WrF_Author
Selection.TypeText Text:=vbTab
' Insert Page
Selection.TypeText Text:="Page "
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:="PAGE ", PreserveFormatting:=True
Selection.TypeText Text:=" of "
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:="NUMPAGES ", PreserveFormatting:=True
' Layout.PageSize 6x9
With ActiveDocument.PageSetup
.PageWidth = InchesToPoints(6)
.PageHeight = InchesToPoints(9)
End With
' Go to Header
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
' Do Not Compress
MsgBox ("File Menu, Options, Advanced, Do Not Compress Images, 330dpi")
End Sub