利用字典功能实现在页眉页脚的自定义

以前按班打印成绩时都是在每个学生旁边都带着班级号,虽然在电脑里无所谓,但打印到纸上时,一般都是按班级打印,这样的话,就显得有点烦琐,既然每个班级的所有学生都在一张纸上,那就没有必要让每个学生都带着班号,只需在页眉或页脚处添加上班号就可以了.但很明显的在电脑里每个学生都要有班号,不然就无法按班级提取了.

原工作表如下图所示:

如上图所示,开始写程序前要将第1列即班级列放在可打印区域外,但不能删掉,因为如果删掉的话,就无数据可提了.完成后的效果如下图所示:

此图中的班级号在页脚处,也可以放在页眉处.

整理后的源程序如下:

Sub 利用字典功能实现自定义页眉页脚功能如班级号班主任姓名等并实现严格按班号打印()
    Dim d As Object
    Dim i As Long, bj
    Set d = CreateObject("scripting.dictionary")
    For i = 1 To Range("A65536").End(xlUp).Row
       If Not d.exists(Cells(i, 1).Value) Then d.Add Cells(i, 1).Value, Cells(i, 2).Value '如将cells(i,2).value写成nothing 则意味着值为空.
    Next i
    '[Q1].Resize(d.Count, 1) = Application.Transpose(d.kyes) 此行用来存储关键字,使可见.
    bj = d.keys
    'Debug.Print d.Count
    '以下为页面设置!!
    With ActiveSheet.PageSetup
        '.PrintArea = Range(Cells(1, 2), Cells(Range("A65536").End(xlUp).Row, Range("IV1").End(xlToLeft).Column))
        .PrintArea = "$B$1:$P$666" '此句非常重要,可以让班级列不再显示.
        .LeftHeader = ""
        .CenterHeader = "&""微软雅黑,常规""&14 2009年11月份模块学分认定考试成绩表"
        .RightHeader = "&D"
        .LeftFooter = ""
        .CenterFooter = ""
        .LeftMargin = Application.InchesToPoints(0.748031496062992)
        .RightMargin = Application.InchesToPoints(0.748031496062992)
        .TopMargin = Application.InchesToPoints(0.984251968503937)
        .BottomMargin = Application.InchesToPoints(0.984251968503937)
        .HeaderMargin = Application.InchesToPoints(0.511811023622047)
        .FooterMargin = Application.InchesToPoints(0.511811023622047)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .CenterHorizontally = True
        .CenterVertically = False
        .Orientation = xlPortrait
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1
        .PrintErrors = xlPrintErrorsDisplayed
    End With
    '以下为打印设置.
    For i = 1 To d.Count - 1
        Debug.Print bj(i)
        ActiveSheet.PageSetup.RightFooter = bj(i) & "班" '在在页脚设置班级号.
        Selection.AutoFilter
        Selection.AutoFilter Field:=1, Criteria1:=bj(i) '按第1个字段(field),条件为班级号进行筛选.下一行为打印命令.
        ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
    Next i
End Sub

 今天你菊子曰了么？