Excel印刷で改ページをまたがるセルの印刷(VBA)

Excelの印刷で、改ページをまたがるセル結合があったときにセル結合に重ならないように改ページを設定するためのマクロは見つかったけど改ページの位置はそのままでセル結合を分割するマクロが無かったので作ってみた。

注意
垂直改ページは無しになります。

Option Explicit

Public Sub 行結合改頁分割()

    Dim strTargetCol()  As String
    Dim strBuff         As String
    Dim xlSheet         As Worksheet
    
    strBuff = "改ページで分割したい結合セルの列名を入力" & vbCrLf & _
              "例)A列、B列を分割する場合は「A,B」と入力する"
    
    strTargetCol = Split(InputBox(strBuff), ",")
    
    Application.ScreenUpdating = True
    
    Set xlSheet = ActiveSheet
    
    If xlSheet.HPageBreaks.Count = 0 Then
        Exit Sub
    End If
    
    '改ページを全て解除
    xlSheet.ResetAllPageBreaks
    
    '垂直改ページをなしにする
    If xlSheet.VPageBreaks.Count > 0 Then
        Call xlSheet.VPageBreaks(1).DragOff(xlToRight, 1)
    End If
    
    
    Dim i               As Long
    Dim j               As Long
    Dim lngHBreakRow    As Long
    Dim objValue
    Dim xlCell          As Range
    Dim lngMergeRowS    As Long
    Dim lngMergeRowE    As Long
    Dim lngTargetCol()  As Long
    
    Application.DisplayAlerts = False
    
    ReDim lngTargetCol(UBound(strTargetCol))
    For i = 0 To UBound(strTargetCol)
        lngTargetCol(i) = Range(strTargetCol(i) & "1").Column
    Next
    
    For i = 0 To UBound(lngTargetCol)
        For j = 1 To xlSheet.HPageBreaks.Count
        
            '改ページの行を取得
            lngHBreakRow = xlSheet.HPageBreaks(j).Location.Row
            
            Set xlCell = Cells(lngHBreakRow, lngTargetCol(i))
            
            '最初だけ改ページを設定する
            '(自動改ページになっているので改ページを指定する)
            If i = 0 Then
                Call xlSheet.HPageBreaks.Add(xlCell)
            End If
            
            '結合セルの開始行、最終行を取得
            lngMergeRowS = xlCell.MergeArea.Row
            lngMergeRowE = lngMergeRowS + xlCell.MergeArea.Rows.Count - 1
            
            '結合セルが改頁をまたいでいる
            If lngMergeRowS < lngHBreakRow Then
            
                'またいでいるセルの値を取得
                objValue = xlCell.MergeArea(1, 1).Value
                
                'またいでいるセルを解除
                xlCell.UnMerge
                
                '改ページから上のセルを結合
                Range(Cells(lngMergeRowS, lngTargetCol(i)), _
                      Cells(lngHBreakRow - 1, lngTargetCol(i))).Merge
                
                '改ページから下のセルを結合
                Range(Cells(lngHBreakRow, lngTargetCol(i)), _
                      Cells(lngMergeRowE, lngTargetCol(i))).Merge
                
                '改ページから下のセルに値を入れる
                Cells(lngHBreakRow, lngTargetCol(i)).MergeArea.Value = objValue
            
            End If
        Next
    Next
    
    Application.DisplayAlerts = True
    
End Sub

実行前

実行後

実行前と実行後の商品の値段が違うのはRAND関数を使ったためです。