批量修改页眉页脚

时间：2017-02-17 17:30:24

Sub 宏1()
'
' 宏1 宏
'
 
'
    Application.PrintCommunication = False
 
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = "&""楷体,常规""XXXXXXXXXXXXXXXXXXX"
        .RightHeader = ""
        .LeftFooter = "&""楷体,常规""&10XXXXXXXXXXXXXX程工程有限公司"
        .CenterFooter = "&""Times New Roman,常规""&P/&N"
        .RightFooter = ""
 
    End With
    Application.PrintCommunication = True
End Sub

有图片资源的

供参考：
Sub tt()
    If MsgBox("页眉是否加载图片？", vbYesNo) = vbYes Then
        With Application.FileDialog(msoFileDialogOpen)
            .Show
            If .SelectedItems.Count > 0 Then pic1 = .SelectedItems(1)
        End With
    End If
    If MsgBox("页脚是否加载图片？", vbYesNo) = vbYes Then
        If MsgBox("页脚图片是否与页眉相同？", vbYesNo) = vbYes Then
            pic2 = pic1
        Else
            With Application.FileDialog(msoFileDialogOpen)
                .Show
                If .SelectedItems.Count > 0 Then pic2 = .SelectedItems(1)
            End With
        End If
    End If
    yym = InputBox("请输入页眉文字：", "输入页眉")
    zyj = InputBox("请输入左页脚文字：", "左页脚")
    Application.ScreenUpdating = False
    For Each sht In Worksheets
        With sht
            .PageSetup.RightHeaderPicture.Filename = pic1
            .PageSetup.LeftFooterPicture.Filename = pic2
            With .PageSetup
                .RightHeader = "&""楷体_GB2312,常规""&10" & yym & "&G"
                .LeftFooter = "&""楷体_GB2312,常规""&10&G" & zyj
                .RightFooter = "&""Times New Roman,常规""&10&P"
            End With
        End With
    Next
    Application.ScreenUpdating = True
End Sub

用宏录制的代码

Sub 测试页脚()
'
' 测试页脚 宏
' 测试页脚
'
' 快捷键: Ctrl+k
'
    Sheets("（表三）甲").Select
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = "$1:$5"
        .PrintTitleColumns = ""
    End With
    Application.PrintCommunication = True
    ActiveSheet.PageSetup.PrintArea = "$A$1:$I$22"
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = "&""仿宋_GB2312,常规""&10第全页"
        .LeftFooter = "&""仿宋_GB2312,常规""&10设计负责人：鱼刺5"
        .CenterFooter = "&""仿宋_GB2312,常规""&10审核:张丁5                          编制:鱼刺5"
        .RightFooter = "&""仿宋_GB2312,常规""&10编制日期：2016年01月"
        .LeftMargin = Application.InchesToPoints(0.78740157480315)
        .RightMargin = Application.InchesToPoints(0.78740157480315)
        .TopMargin = Application.InchesToPoints(0.984251968503937)
        .BottomMargin = Application.InchesToPoints(0.984251968503937)
        .HeaderMargin = Application.InchesToPoints(1.65354330708661)
        .FooterMargin = Application.InchesToPoints(1.02362204724409)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = True
        .CenterVertically = True
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 100
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = False
        .EvenPage.LeftHeader.Text = ""
        .EvenPage.CenterHeader.Text = ""
        .EvenPage.RightHeader.Text = ""
        .EvenPage.LeftFooter.Text = ""
        .EvenPage.CenterFooter.Text = ""
        .EvenPage.RightFooter.Text = ""
        .FirstPage.LeftHeader.Text = ""
        .FirstPage.CenterHeader.Text = ""
        .FirstPage.RightHeader.Text = ""
        .FirstPage.LeftFooter.Text = ""
        .FirstPage.CenterFooter.Text = ""
        .FirstPage.RightFooter.Text = ""
    End With
    Application.PrintCommunication = True
End Sub

经测试2013EXCEL必须下面这样操作才可以。

Sub 改页脚()
'
' 改页脚 宏
' 改页脚
'
' 快捷键: Ctrl+k
'
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = "$1:$1"
        .PrintTitleColumns = ""
    End With
    Application.PrintCommunication = True
    ActiveSheet.PageSetup.PrintArea = "$A$1:$I$128"
     
     
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .LeftHeader = "顶左7"
        .LeftFooter = "底左7"
    End With
     
    Application.PrintCommunication = True
     
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .CenterHeader = "&""仿宋_GB2312,常规""顶中7"
        .CenterFooter = "底中7"
    End With
    Application.PrintCommunication = True
     
     
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .RightHeader = "顶右6"
        .RightFooter = "底右7"
    End With
    Application.PrintCommunication = True
End Sub