[已解决]让页眉显示当前页面的某一单元格内容

liu6930101

想让页眉在打印的时候显示当前页面的某一单元格内容   比如A2  
百度了宏如下
Sub Myrange()     ActiveSheet.PageSetup.CenterHeader = "" & ActiveCell.Value End Sub

可这个宏只能显示固定的内容
如何让它随预览的当前页面变化而变化呢？跪求高手指点！！！

最佳答案

月排行榜 / 总排行榜

爱疯

2016-8-25 11:15

Sub RunSubtotal()
    Dim c
    c = 1    '分类列的列号
    With Sheets("原材料")
        '1）删除分类汇总
        .Range("a1").CurrentRegion.RemoveSubtotal
        '2）对要分类的字段，排升序
        .Cells(1, c).CurrentRegion.Sort key1:=.Cells(1, c), order1:=xlAscending, Header:=xlYes
        '3）以第一个字段进行分组的求和，汇总对象为第四到第七个字段。
        .Range("a1").CurrentRegion.Subtotal GroupBy:=c, Function:=xlSum, TotalList:=Array(4, 5, 6, 7)
        '.Outline.ShowLevels RowLevels:=3
        .Columns(c).Replace "汇总", "累计"
        .Rows(.Range("a1").CurrentRegion.Rows.Count).Delete
        .Range("a1").CurrentRegion.Borders.LineStyle = 1
    End With
    Call PrintBySubtotal(c)
End Sub



Sub PrintBySubtotal(c)
    Dim A, i, r
    Application.DisplayAlerts = False
    With Sheets.Add(after:=Sheets(Sheets.Count))
        .PageSetup.Orientation = xlLandscape
        .PageSetup.PrintTitleRows = "$1:$1"
        Sheets("原材料").[a1:i1].Copy .[a1]
        r = 2
        A = Sheets("原材料").Range("a1").CurrentRegion
        For i = 2 To UBound(A)
            If A(i, c) Like "* 累计" Then
                .Rows("2:65536").Clear
                Sheets("原材料").Cells(r, 1).Resize(i - r + 1, 9).Copy
                r = i + 1
                .Range("a2").PasteSpecial xlPasteFormats
                .Range("a2").PasteSpecial xlPasteValues
                .Cells.Columns.AutoFit
                .PageSetup.CenterHeader = .[A2]
                .PrintOut
            End If
        Next i
        .Delete
    End With
End Sub


原材料3.rar (51.14 KB, 下载次数: 23)

2016-8-25 11:15 上传

点击文件名下载附件

跳转到最佳答案楼层

su45

ActiveSheet.PageSetup.CenterHeader = Range("A2").Text

爱疯

建议上传自己的excel文件，并说明效果

别人才好理解。

liu6930101

su45 发表于 2016-8-24 11:24
ActiveSheet.PageSetup.CenterHeader = Range("A2").Text

我试着用了，可是还是不对啊，高手帮忙看看怎么回事啊   我上传了附件

liu6930101

爱疯 发表于 2016-8-24 11:31
建议上传自己的excel文件，并说明效果

别人才好理解。

大神  我已上传了附件    帮忙看看吧   

pengyx

楼主的页眉并不是要显示A2，而是要显示打印在纸上看到的第一列的第二个单元格。这个问题就是求出打印在纸上看到的第一列的第二个单元格，对应在表中是哪个单元格。是否楼主？

liu6930101

pengyx 发表于 2016-8-24 16:11
楼主的页眉并不是要显示A2，而是要显示打印在纸上看到的第一列的第二个单元格。这个问题就是求出打印在纸上 ...

对   不是A2    是打印在纸上的第一列第二个单元格的内容    同步显示在当前页眉上         亲有办法吗

爱疯

Sub AddSubtotal()
    Dim c
    c = 1    '分类列的列号
    With Sheets("原材料")
        '1）删除分类汇总
        .Range("a1").CurrentRegion.RemoveSubtotal
        '2）对要分类的字段，排升序
        .Cells(1, c).CurrentRegion.Sort key1:=.Cells(1, c), order1:=xlAscending, Header:=xlYes
        '3）以第一个字段进行分组的求和，汇总对象为第四到第七个字段。
        .Range("a1").CurrentRegion.Subtotal GroupBy:=c, Function:=xlSum, TotalList:=Array(4, 5, 6, 7)

        '.Outline.ShowLevels RowLevels:=3
        .Rows(.Range("a1").CurrentRegion.Rows.Count).Delete
        .Range("a1").CurrentRegion.Borders.LineStyle = 1
    End With
    Call PrintBySubtotal(c)
End Sub


Sub PrintBySubtotal(c)
    Dim A, i, r
    With Sheets("辅助表")
        .PageSetup.Orientation = xlLandscape
        .PageSetup.PrintTitleRows = "$1:$1"
        A = Sheets("原材料").Range("a1").CurrentRegion
        r = 2
        For i = 2 To UBound(A)
            If A(i, c) Like "* 汇总" Then
                .Rows("2:65536").Clear
                Sheets("原材料").Range(Sheets("原材料").Cells(r, 1), Sheets("原材料").Cells(i, UBound(A, 2))).Copy
                r = i + 1
                .Range("a2").PasteSpecial xlPasteFormats
                .Range("a2").PasteSpecial xlPasteValues
                .Cells.Columns.AutoFit
                .PageSetup.CenterHeader = .[A2]
                .PrintOut
            End If
        Next i
    End With
End Sub

原材料2.rar (55.86 KB, 下载次数: 11)

2016-8-24 17:48 上传

点击文件名下载附件



http://zhidao.baidu.com/link?url ... HQgQO6egcW7Pm3GyAi_
这样可以吗？
对于"分类汇总操作"，好像如这链接里所说，只有online对象（分级显示）可用，再找不着更多的现有对象了。。。。
AddSubtotal()，是按原帖意思用代码执行分类汇总的操作。
PrintBySubtotal(c)，是采取人为判断方式：如果分类列有" 汇总"的字样，就复制到辅助表中并打印。

liu6930101

爱疯 发表于 2016-8-24 17:55
Sub AddSubtotal()
    Dim c
    c = 1    '分类列的列号

没错   我打印了   就是这个效果   
不过  
“汇总”字样    我要是改成“累计”还能用吗
还有那个辅助表    我要是把这个宏引用到其他表格中    需要自己建立一个辅助表是吗？

爱疯

Sub RunSubtotal()
    Dim c
    c = 1    '分类列的列号
    With Sheets("原材料")
        '1）删除分类汇总
        .Range("a1").CurrentRegion.RemoveSubtotal
        '2）对要分类的字段，排升序
        .Cells(1, c).CurrentRegion.Sort key1:=.Cells(1, c), order1:=xlAscending, Header:=xlYes
        '3）以第一个字段进行分组的求和，汇总对象为第四到第七个字段。
        .Range("a1").CurrentRegion.Subtotal GroupBy:=c, Function:=xlSum, TotalList:=Array(4, 5, 6, 7)
        '.Outline.ShowLevels RowLevels:=3
        .Columns(c).Replace "汇总", "累计"
        .Rows(.Range("a1").CurrentRegion.Rows.Count).Delete
        .Range("a1").CurrentRegion.Borders.LineStyle = 1
    End With
    Call PrintBySubtotal(c)
End Sub



Sub PrintBySubtotal(c)
    Dim A, i, r
    Application.DisplayAlerts = False
    With Sheets.Add(after:=Sheets(Sheets.Count))
        .PageSetup.Orientation = xlLandscape
        .PageSetup.PrintTitleRows = "$1:$1"
        Sheets("原材料").[a1:i1].Copy .[a1]
        r = 2
        A = Sheets("原材料").Range("a1").CurrentRegion
        For i = 2 To UBound(A)
            If A(i, c) Like "* 累计" Then
                .Rows("2:65536").Clear
                Sheets("原材料").Cells(r, 1).Resize(i - r + 1, 9).Copy
                r = i + 1
                .Range("a2").PasteSpecial xlPasteFormats
                .Range("a2").PasteSpecial xlPasteValues
                .Cells.Columns.AutoFit
                .PageSetup.CenterHeader = .[A2]
                .PrintOut
            End If
        Next i
        .Delete
    End With
End Sub


原材料3.rar (51.14 KB, 下载次数: 23)

2016-8-25 11:15 上传

点击文件名下载附件