Excel VBA 实现跨页合并单元格后重新合并并适应分页打印

应用场景

跨页合并单元格后重新合并并适应分页打印

知识要点

1：ActiveWindow.View = xlPageBreakPreview 分页预览模式，判断分页符位置

2：HPageBreaks 对象  打印区域内水平分页符的集合

3：HPageBreak.Location 属性  返回或设置定义分页符位置的单元格（Range 对象）。

4：判断页面的最后一个单元格与下一页第一个单元格是否处于同一合并区域

5：Range.UnMerge 方法 将合并区域分解为独立的单元格

6：合并单元格是否跨页只能在分页预览模式下才体现出来

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

ActiveWindow.View = xlNormalView '还原为常规视图

End Sub

版权声明：本文内容由网络用户投稿，版权归原作者所有，本站不拥有其著作权，亦不承担相应法律责任。如果您发现本站中有涉嫌抄袭或描述失实的内容，请联系我们jiasou666@gmail.com 处理，核实后本网站将在24小时内删除侵权内容。