设置word横向页眉页脚的宏脚本

做长文档的时候难免会因为表格或者图片等超长的内容，我们往往是利用分节符后，把页面设置成横向以方便布局。但这样一来在设置页眉和页脚时word却没有相应的把页眉与页脚相应的进行调整，导致打印出来后，横向页面的页眉与页脚位于纸的长边，与纵向页不一致。因此做了这个设置横向页眉与页脚的宏脚本 。
原理就是在页眉页脚视图中，利用新加两个文本框，一个位于横向纸的右边作为新的页眉，一个位于纸的左边作为新的页脚。然后调整文本框大小与位置，使其与纵向纸的页眉页脚位置一致。最后把文本框的文字内容更改一下文字方向即可使之打印装订后与纵向纸一致。
此脚本是针对A4纸设定的，如要更改纸张需要对文本框位置与大小做相应调整。由于新加了一个窗口用户对新的页眉页脚进行简单设置，所以宏里包含一个自定义窗口。通过窗口的按钮事件运行宏脚本。主要内容如下：
Private Sub CommandButton1_Click()
'页眉
If Trim(txtYM.Text) <> "" Then
'检查是否当前为页眉页脚视图
If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
ActiveWindow.Panes(2).Close
End If
If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
ActivePane.View.Type = wdOutlineView Then
ActiveWindow.ActivePane.View.Type = wdPrintView
End If
' '去除链接到前一节
' ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter
' Selection.HeaderFooter.LinkToPrevious = False
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
' Selection.HeaderFooter.LinkToPrevious = False
'插入页眉文本框
Selection.HeaderFooter.Shapes.AddTextbox(msoTextOrientationHorizontal, _
783.15, 85.05, 35, 453.6).Select
Selection.ShapeRange.TextFrame.TextRange.Select
Selection.Collapse
Selection.ShapeRange.Select
Selection.ShapeRange.Fill.Visible = msoFalse
Selection.ShapeRange.Fill.Solid
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Line.Weight = 0
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoFalse
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.Height = CentimetersToPoints(14.66) '设置文本框高度
Selection.ShapeRange.Width = 15 '设置文本框宽度
Selection.ShapeRange.Left = 0 '设置文本框左边距
Selection.ShapeRange.Top = 85# '设置文本框顶边距
Selection.ShapeRange.TextFrame.MarginLeft = 0
Selection.ShapeRange.TextFrame.MarginRight = 0
Selection.ShapeRange.TextFrame.MarginTop = 0
Selection.ShapeRange.TextFrame.MarginBottom = 0
Selection.ShapeRange.RelativeHorizontalPosition = _
wdRelativeHorizontalPositionColumn
Selection.ShapeRange.RelativeVerticalPosition = _
wdRelativeVerticalPositionParagraph
Selection.ShapeRange.Left = CentimetersToPoints(24.8) '设置文本框左边相对位置(厘米转为磅)
Selection.ShapeRange.Top = CentimetersToPoints(1.7) '设置文本框顶边相对位置
Selection.ShapeRange.LockAnchor = False
Selection.ShapeRange.LayoutInCell = True
Selection.ShapeRange.WrapFormat.AllowOverlap = True
Selection.ShapeRange.WrapFormat.Side = wdWrapBoth
Selection.ShapeRange.WrapFormat.DistanceTop = CentimetersToPoints(0)
Selection.ShapeRange.WrapFormat.DistanceBottom = CentimetersToPoints(0)
Selection.ShapeRange.WrapFormat.DistanceLeft = CentimetersToPoints(0)
Selection.ShapeRange.WrapFormat.DistanceRight = CentimetersToPoints(0)
Selection.ShapeRange.WrapFormat.Type = 3
Selection.ShapeRange.ZOrder 4
Selection.ShapeRange.TextFrame.AutoSize = False
Selection.ShapeRange.TextFrame.WordWrap = True
Selection.ShapeRange.ScaleWidth 1.67, msoFalse, msoScaleFromTopLeft '文本框宽度放大1.67倍
Selection.ShapeRange.TextFrame.TextRange.Select '选中文本框内容
Selection.Collapse
Selection.Orientation = wdTextOrientationVerticalFarEast
'页眉文字内容
Selection.TypeText Text:=txtYM.Text
With Selection.ParagraphFormat
.Borders(wdBorderLeft).LineStyle = wdLineStyleNone
.Borders(wdBorderRight).LineStyle = wdLineStyleNone
.Borders(wdBorderTop).LineStyle = wdLineStyleNone
If cbYeMeiXHX.Value Then
With .Borders(wdBorderBottom)
.LineStyle = wdLineStyleSingle '设置下横线
.LineWidth = wdLineWidth050pt '设置横线宽
.Color = wdColorAutomatic
End With
Else
.Borders(wdBorderBottom).LineStyle = wdLineStyleNone
End If
With .Borders
.DistanceFromTop = 1
.DistanceFromLeft = 4
.DistanceFromBottom = 1
.DistanceFromRight = 4
.Shadow = False
End With
Selection.Orientation = wdTextOrientationDownward '更改页眉文字方向
End With
With Options
.DefaultBorderLineStyle = wdLineStyleSingle
.DefaultBorderLineWidth = wdLineWidth050pt
.DefaultBorderColor = wdColorAutomatic
End With
With Selection.ParagraphFormat '设置段落格式
.LeftIndent = CentimetersToPoints(0)
.RightIndent = CentimetersToPoints(0)
.SpaceBefore = 5
.SpaceBeforeAuto = True
.SpaceAfter = 5
.SpaceAfterAuto = True
.LineSpacingRule = wdLineSpaceSingle
.Alignment = cbYMDQ.ListIndex '设置对齐
.WidowControl = False
.KeepWithNext = False
.KeepTogether = False
.PageBreakBefore = False
.NoLineNumber = False
.Hyphenation = True
.FirstLineIndent = CentimetersToPoints(0)
.OutlineLevel = wdOutlineLevelBodyText
.CharacterUnitLeftIndent = 0
.CharacterUnitRightIndent = 0
.CharacterUnitFirstLineIndent = 0
.LineUnitBefore = 0
.LineUnitAfter = 0
.AutoAdjustRightIndent = True
.DisableLineHeightGrid = False
.FarEastLineBreakControl = True
.WordWrap = True
.HangingPunctuation = True
.HalfWidthPunctuationOnTopOfLine = False
.AddSpaceBetweenFarEastAndAlpha = True
.AddSpaceBetweenFarEastAndDigit = True
.BaseLineAlignment = wdBaselineAlignAuto
End With
End If
If cbYeMa.Value Or cbDBX.Value Then
'设置页脚
If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
ActiveWindow.Panes(2).Close
End If
If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
ActivePane.View.Type = wdOutlineView Then
ActiveWindow.ActivePane.View.Type = wdPrintView
End If
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter
Selection.ShapeRange.Flip msoFlipHorizontal
Selection.HeaderFooter.Shapes.AddTextbox(msoTextOrientationHorizontal, _
19.1, 85.05, 37.3, 453.6).Select
Selection.ShapeRange.TextFrame.TextRange.Select
Selection.Collapse
Selection.ShapeRange.Select
Selection.ShapeRange.Fill.Visible = msoFalse
Selection.ShapeRange.Fill.Solid
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Line.Weight = 0
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoFalse
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.Height = CentimetersToPoints(14.66)
Selection.ShapeRange.Width = 25
Selection.ShapeRange.Left = 300
Selection.ShapeRange.Top = 85#
Selection.ShapeRange.TextFrame.MarginLeft = 0
Selection.ShapeRange.TextFrame.MarginRight = 0
Selection.ShapeRange.TextFrame.MarginTop = 0
Selection.ShapeRange.TextFrame.MarginBottom = 0
Selection.ShapeRange.RelativeHorizontalPosition = _
wdRelativeHorizontalPositionColumn
Selection.ShapeRange.RelativeVerticalPosition = _
wdRelativeVerticalPositionParagraph
Selection.ShapeRange.Left = CentimetersToPoints(-1.2)
Selection.ShapeRange.Top = CentimetersToPoints(1.7)
Selection.ShapeRange.LockAnchor = False
Selection.ShapeRange.LayoutInCell = True
Selection.ShapeRange.WrapFormat.AllowOverlap = True
Selection.ShapeRange.WrapFormat.Side = wdWrapBoth
Selection.ShapeRange.WrapFormat.DistanceTop = CentimetersToPoints(0)
Selection.ShapeRange.WrapFormat.DistanceBottom = CentimetersToPoints(0)
Selection.ShapeRange.WrapFormat.DistanceLeft = CentimetersToPoints(0.32)
Selection.ShapeRange.WrapFormat.DistanceRight = CentimetersToPoints(0.32)
Selection.ShapeRange.WrapFormat.Type = 3
Selection.ShapeRange.ZOrder 4
Selection.ShapeRange.TextFrame.AutoSize = False
Selection.ShapeRange.TextFrame.WordWrap = True
Selection.ShapeRange.TextFrame.TextRange.Select
Selection.Collapse
Selection.Orientation = wdTextOrientationVerticalFarEast
Selection.WholeStory '全选
If cbYeMa.Value Then
' Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldPage '插入页码域
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
"PAGE", PreserveFormatting:=True '按全文设置的页码格式,更改可在page域后加开关
Selection.WholeStory
End If
Selection.Orientation = wdTextOrientationDownward
ActiveWindow.ActivePane.VerticalPercentScrolled = 0
With Selection.ParagraphFormat
.Borders(wdBorderLeft).LineStyle = wdLineStyleNone
.Borders(wdBorderRight).LineStyle = wdLineStyleNone
.Borders(wdBorderBottom).LineStyle = wdLineStyleNone
If cbDBX.Value Then
With .Borders(wdBorderTop) '设置顶横线
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth050pt
.Color = wdColorAutomatic
End With
Else
.Borders(wdBorderTop).LineStyle = wdLineStyleNone
End If
With .Borders
.DistanceFromTop = 1
.DistanceFromLeft = 4
.DistanceFromBottom = 1
.DistanceFromRight = 4
.Shadow = False
End With
End With

With Selection.ParagraphFormat
.LeftIndent = CentimetersToPoints(0)
.RightIndent = CentimetersToPoints(0)
.SpaceBefore = 5
.SpaceBeforeAuto = True
.SpaceAfter = 5
.SpaceAfterAuto = True
.LineSpacingRule = wdLineSpaceSingle
.Alignment = cbYJDQ.ListIndex
.WidowControl = False
.KeepWithNext = False
.KeepTogether = False
.PageBreakBefore = False
.NoLineNumber = False
.Hyphenation = True
.FirstLineIndent = CentimetersToPoints(0)
.OutlineLevel = wdOutlineLevelBodyText
.CharacterUnitLeftIndent = 0
.CharacterUnitRightIndent = 0
.CharacterUnitFirstLineIndent = 0
.LineUnitBefore = 0
.LineUnitAfter = 0
.AutoAdjustRightIndent = True
.DisableLineHeightGrid = False
.FarEastLineBreakControl = True
.WordWrap = True
.HangingPunctuation = True
.HalfWidthPunctuationOnTopOfLine = False
.AddSpaceBetweenFarEastAndAlpha = True
.AddSpaceBetweenFarEastAndDigit = True
.BaseLineAlignment = wdBaselineAlignAuto
End With
End If
'回到普通视图
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
MsgBox "横向页眉页脚设置完毕！", vbInformation + vbOKOnly, "提示"
End Sub 代码中的txtYM为页眉文字内容的文本框控件，cbYMDQ与cbYJDQ为两个控制页眉与页脚对齐方式的两个下拉控件，cbYeMeiXHX与cbDBX为设置页眉是否有下划线既页脚是否有顶边线的复选框。
页脚处页码的格式采用域的方式插入，此处为标准的方式，如要换成别的样式可以在PAGE域后面加相应的开关。
以下为设置窗体初始代码，用于在两个下柆框里填充数据：
Private Sub UserForm_Initialize()
With cbYMDQ
.AddItem "左对齐", 0
.AddItem "居中对齐", 1
.AddItem "右对齐", 2
.AddItem "两端对齐", 3
.AddItem "分散对齐", 4
.ListIndex = 1
End With
With cbYJDQ
.AddItem "左对齐", 0
.AddItem "居中对齐", 1
.AddItem "右对齐", 2
.AddItem "两端对齐", 3
.AddItem "分散对齐", 4
.ListIndex = 1
End With
End Sub
原文件下载，使用的时候可以打开word后，按alt+F11进行VBA环境，然后点击文件，导入文件可导入此处的设置窗口。