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

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

作者：而且  来源：博客园  发布时间：2008-03-20 09:18  阅读：3042 次  原文链接   [收藏]  

    做长文档的时候难免会因为表格或者图片等超长的内容，我们往往是利用分节符后，把页面设置成横向以方便布局。但这样一来在设置页眉和页脚时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