希望在打印模块增加分类打印功能及合并单元格合理分贝功能

这两个我是通过代码实现的，代码也简单，希望格子能添加进去

Sub 筛选指定列不同项分别打印()
    Dim d
    Dim arr(), brr()
    Dim i%, nrow%, s%
    Dim rng As Range
    t = Timer
    Application.ScreenUpdating = False '停止屏幕刷新
    Application.DisplayAlerts = False '停止警告
    Set rng = Application.InputBox("请选择要筛选打印的单元格！只能选择一个单元格", Title:="提示", Type:=8)
    srow = rng.Row '选取单元格所在行
    scol = rng.Column '选取单元格所在列
    nrow = Cells(srow, scol).End(xlDown).Row '选取单元格所在列的最后一行
    arr = Range(Cells(srow, scol), Cells(nrow, scol))  '把筛选所在列装入数组
    s = UBound(arr)    '一维数组最后项数
    Set d = CreateObject("Scripting.Dictionary")    '创建字典对象
    For i = srow + 1 To s  '循环数组各项
        d(arr(i, 1)) = ""    '纳入字典
    Next
    
    rng.EntireRow.AutoFilter    '选取单元格所在行，即标题行
    For i = 1 To d.Count    '循环字典项
        Selection.AutoFilter Field:=scol, Criteria1:=d.keys()(i - 1)  '以字典各项自动筛选
        ActiveWindow.SelectedSheets.PrintOut   '打印当前表
    Next
    Selection.AutoFilter    '取消自动筛选，全部显示
    Application.ScreenUpdating = True '开启屏幕刷新
    Application.DisplayAlerts = True '开启删除警告
    t = Timer - t
    MsgBox "打印完成，用时" & t & "秒"
End Sub

Sub 重组跨页合并() '将跨页的合并单元格重新合并从而适应分页打印
    Dim p, MerageAddress As String, PageCell As Range, MergeValue
    Application.ScreenUpdating = False
    ActiveWindow.View = xlPageBreakPreview '进入分页预览，才可以判断分页符位置
    For Each p In ActiveSheet.HPageBreaks  '逐页循环 hpagebreaks对象，打印区域内水平分页符的集合
        'hpagebreak.location属性，返回或设置定义分页符位置的单元格(range对象)
        Set PageCell = Cells(p.Location.Row - 1, ActiveCell.Column) '将每个分页最后一个单元格赋予变量
        '如果该页最后一个单元格具有合并属性，而且与下一页第一个单元格处于同一个合并区域
        If PageCell.MergeCells And Not Intersect(Cells(p.Location.Row, ActiveCell.Column), PageCell.MergeArea) Is Nothing Then
            MerageAddress = PageCell.MergeArea.Address '取得合并区域的地址
            MergeValue = PageCell.MergeArea(1).Value '取得合并区域的值
            PageCell.MergeArea.UnMerge '取消合并
            Range(Range(MerageAddress)(1), PageCell).Merge '将合并区域中处于本页的单元格合并
            Range(Range(MerageAddress)(1), PageCell).Borders.LineStyle = xlContinuous '添加边框
            With Range(PageCell.Offset(1, 0), Cells(Split(MerageAddress, "$")(4), ActiveCell.Column))
                .Merge '再将合并区域中处于下一页的单元格合并
                .Value = MergeValue '赋值
                .HorizontalAlignment = xlCenter '左右居中
                .VerticalAlignment = xlCenter '上下居中
                .Borders.LineStyle = xlContinuous
            End With
        End If
    Next
    Application.ScreenUpdating = True
End Sub

回复：2楼

比如说一个公司有10个部门

我有一个总表，我要分部门打印，普通打印肯定是筛选部门，一个部门一个部门来进行打印

而这个代码就能实现选择部门后自动进行分部门打印