• 设置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.1585.0535453.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.185.0537.3453.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环境,然后点击文件,导入文件可导入此处的设置窗口。
  • 相关阅读:
    GLSL 变量属性
    php读取大文件的方法
    php 3种常见设计模式
    php类自动装载、链式操作、魔术方法
    统计文件中关键词出现的次数
    python先序、中序、后序排序
    Nginx缓存、压缩配置
    Ninx虚拟主机的配置
    python爬虫代码
    Nginx在安装过程经常出现的问题
  • 原文地址:https://www.cnblogs.com/erqie/p/1114156.html
Copyright © 2020-2023  润新知