Question

excel vba For Each P In ActiveSheet.HPageBreaks 下标越界

Sub 重组跨页合并() '将跨页的合并单元格重新合并从而适应分页打印
Dim P, MergeAddress As String, PageCell As Range, MergeValue
Application.ScreenUpdating = False
ActiveWindow.View = xlPageBreakPreview '进入分页预览，才可以判断分页符位置
For Each P In ActiveSheet.HPageBreaks '逐页循环
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
MergeAddress = PageCell.MergeArea.Address '取得合并区域的地址
MergeValue = PageCell.MergeArea(1).Value '取得合并区域的值
PageCell.MergeArea.UnMerge '取消合并
Range(Range(MergeAddress)(1), PageCell).Merge '将合并区域中处于本页的单元格合并
Range(Range(MergeAddress)(1), PageCell).Borders.LineStyle = xlContinuous '添加边框
With Range(PageCell.Offset(1, 0), Cells(Split(MergeAddress, "$")(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

Answer 1

Sub 合并单元跨页()
    Dim rng As Range
    col = ActiveSheet.UsedRange.Columns.Count
    ActiveWindow.View = xlPageBreakPreview
    n = ActiveWindow.SelectedSheets.HPageBreaks.Count
        For i = 1 To n
            ir = ActiveWindow.SelectedSheets.HPageBreaks(i).Location.Row
            For j = 1 To col
            Set rng = Cells(ir, j)
            If rng.MergeArea.Row <> ir Then
                ic = rng.MergeArea.Columns.Count
                ss = Split(rng.MergeArea.Address, ":")
                ss1 = Split(ss(0), "$")(2)
                ss2 = Split(ss(1), "$")(2)
                rng.UnMerge
                Range(Cells(ss1, j), Cells(ir - 1, j + ic - 1)).Merge
                Range(Cells(ir, j), Cells(ss2, j + ic - 1)).Merge
                rng = Cells(ss1, j)
                j = j + ic - 1
            End If
        Next
        Range(Cells(ir - 1, 1), Cells(ir - 1, col)).Borders(xlEdgeBottom).Weight = xlMedium
        Range(Cells(ir, 1), Cells(ir, col)).Borders(xlEdgeTop).Weight = xlMedium
    Next
    ActiveWindow.View = xlNormalView
End Sub

Answer 2

运行没有报错，这个可能和你的页面格式有关

追问

能详细说说么？
我的A\B\C\D\E都有跨页合并单元格 纸张方向 横向 中文名称