如何在顶端标题行显示变化的内容

kezhiye

本表现有代码的功能是按A列类别插入分页符，并且已经设置了三行顶端标题行。现在我想打印的时候在每一页第二行的黄色单元格位置显示当前页的类别，即本例第一页显示长衫，第二页显示马夹，第三页显示背心。

请教代码要如何修改？谢谢

如何在顶端标题行显示变化的内容.rar (19.33 KB, 下载次数: 14)

2018-11-28 13:18 上传

点击文件名下载附件

tyxvba7529

打印标题还能改吗？ 可以按类别拆多个sheet来打印

kezhiye

没有办法让顶端标题行的内容变化吗？

MOY838840554

把打印代码也加进去
Sub 宏1()
    Dim i%, k%, ii, arr, j, n
    j = 1
    k = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
    Application.ScreenUpdating = False
    ActiveSheet.ResetAllPageBreaks
    '**********插入页码并获取页数
    For i = 5 To k
        If Cells(i, 1) <> Cells(i - 1, 1) Then
            ActiveSheet.HPageBreaks.Add Before:=Cells(i, 1)
            j = j + 1
        End If
    Next
        '**********获取类别
        ReDim arr(1 To j)
        arr(1) = Cells(4, 1)
        j = 1
        For i = 5 To k
        If Cells(i, 1) <> Cells(i - 1, 1) Then
        j = j + 1
        arr(j) = Cells(i, 1)
        End If
       Next
       '**********一页一页打印
       n = ActiveSheet.PageSetup.Pages.Count '获取打印总页数
       For i = 1 To n
       Cells(2, 2) = arr(i) '改变B2值
    ActiveWindow.SelectedSheets.PrintOut From:=i, to:=i, Copies:=1, Collate _
        :=True, IgnorePrintAreas:=False
        Next i
   ' ActiveSheet.PrintOut
    Application.ScreenUpdating = True
   
End Sub

MOY838840554

卡回复了。。。。

kezhiye

MOY838840554 发表于 2018-11-29 17:38
把打印代码也加进去
Sub 宏1()
    Dim i%, k%, ii, arr, j, n

谢谢师傅！要的就是这个效果，这样本身的工作表看上去就整洁多了，不用每页插入三行作为表头

kezhiye

师傅您好！感谢您在"如何在顶端标题行显示变化的内容"贴子中提供的代码，效果达到了，但在实际操作中还有一个需求，麻烦您再帮我看看能不能实现：目前是执行代码，就自动从头到尾一下打印出来了，能不能改成执行代码先出现一个普通的打印页面，就是我们平时打印的时候，先出现一个可以选择打印机和指定打印页的那个界面，这样的话，就可以指定从第几页打印到第几页。

MOY838840554

kezhiye 发表于 2018-11-30 11:16
师傅您好！感谢您在"如何在顶端标题行显示变化的内容"贴子中提供的代码，效果达到了，但在实际操作中还有一 ...

效果可以实现，弹对话框可以吧，现在代码的一页一页打印就是调用页数打印的，第一次1至1，第2次2到2，每次都改B2的值，这个就被占用了，我写个弹出输入窗代替你说的这个打印界面吧

kezhiye

MOY838840554 发表于 2018-11-30 11:42
效果可以实现，弹对话框可以吧，现在代码的一页一页打印就是调用页数打印的，第一次1至1，第2次2到2，每 ...

谢谢您的热心帮助！弹对话框输入要打印的页数完全可以。另外请教一下，对话框里能不能显示出总的有多少页，如果能看出总的有多页，那就更完美了

MOY838840554

把关闭屏幕刷新的代码删了，顺便把不能全部打印的修改好了
Sub 自动打印()
    Dim i%, j, k%, arr, n$, m%
    Dim 页数%, 描述$, 输入$, 打印页数, df$
    页数 = 1: 描述 = "": df = "全部打印"
    k = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
    ActiveSheet.ResetAllPageBreaks
    On Error GoTo 跳过:
    '**********插入页码并获取页数
    For i = 5 To k
        If Cells(i, 1) <> Cells(i - 1, 1) Then
            ActiveSheet.HPageBreaks.Add Before:=Cells(i, 1)
            页数 = 页数 + 1
        End If
    Next
        '**********获取类别，并存入数组arr,生成描述
        ReDim arr(1 To 页数)
        j = 1
        arr(j) = Cells(4, 1)
        描述 = 描述 & "【" & j & "】" & arr(j) & ";"
        For i = 5 To k
        If Cells(i, 1) <> Cells(i - 1, 1) Then
        j = j + 1
        arr(j) = Cells(i, 1)
        If j Mod 6 = 0 Then 描述 = 描述 & Chr(10)
        描述 = 描述 & "【" & j & "】" & arr(j) & ";"
        End If
       Next
       '**********输入打印页码
re:
m = 0
       输入 = InputBox("输入打印范围： " & Chr(10) & "（1）：【2-7】打印2至7页" & Chr(10) _
       & "（2）：【1.3.4.6.8.9】打印指定页(升序)" & Chr(10) _
       & "【可打印总页数】：" & 页数 & "页" & Chr(10) & 描述, "打印范围", df)
       If 输入 = "" Then
       MsgBox "取消打印", , "提示"
       Exit Sub
       ElseIf 输入 <> "全部打印" And IsNumeric(Replace(Replace(输入, ".", ""), "-", "")) = False Then '初步验证输入的内容
        MsgBox "输入非数字字符", , "提示"
        df = 输入
       GoTo re:
       End If
       '**********处理输入的文本
       If 输入 = "全部打印" Then '全部打印
       ReDim 打印页数(0 To 页数 - 1)
       For i = 0 To 页数 - 1
       打印页数(m) = i
       m = m + 1
       Next
       ElseIf InStr(输入, "-") > 0 Then 'N-M页
       n = InStr(输入, "-")
       If Replace(输入, Left(输入, n), "") > j Or IsNumeric(Replace(输入, Left(输入, n), "")) = False Then
       MsgBox "输入错误,或【输入页数】不可大于【最大页数】", , "注意"
        df = 输入
       GoTo re:
       End If
       ReDim 打印页数(0 To Replace(输入, Left(输入, n), "") - Left(输入, n - 1))
       For i = Left(输入, n - 1) * 1 To Replace(输入, Left(输入, n), "") * 1
       打印页数(m) = i
       m = m + 1
       Next
       Else '打印指定页
       打印页数 = Split(输入, ".")
       If 打印页数(UBound(打印页数)) * 1 > j Then
       MsgBox "【输入页数】不可大于【最大页数】", , "注意"
       df = 输入
       GoTo re:
       End If
       End If
       '**********一页一页打印
       For i = 1 To UBound(打印页数) + 1
       Cells(2, 2) = arr(i) '改变B2值
    ActiveWindow.SelectedSheets.PrintOut From:=i, To:=打印页数(i - 1), Copies:=打印页数(i - 1), Collate _
       :=True, IgnorePrintAreas:=False
        Next i
        MsgBox "打印完毕", , "提示"
跳过:
End Sub