'ページ毎に左右の余白を入れ替えて印刷するマクロ

Option Explicit

Sub Print_MarginChange()
    Const myTitle As String = "左右の余白を入れ替えて印刷"
    Dim dfMargin(0 To 1) As Double
    Dim iPageCount(0 To 1)  As Long
    Dim vVPageBreaks(0 To 1) As Variant
    Dim vHPageBreaks(0 To 1) As Variant
    Dim bRet As Boolean
    Dim iRet As Long, i As Long

    On Error GoTo ErrorHandler

    Application.StatusBar = False

    'アクティブシートの種類をチェック
    If TypeName(ActiveSheet) <> "Worksheet" Then
        iRet = MsgBox("ワークシートを選択して実行してください。", _
            vbExclamation, myTitle)
        Exit Sub
    End If

    '確認メッセージの表示
    iRet = MsgBox("ページ毎に左右の余白を入れ替えて印刷します。" _
        & Chr$(10) & "ページ設定は現在のものを使用します。" & Chr$(10) & _
        "印刷ジョブはページ毎に作成されます。", _
        vbExclamation Or vbOKCancel, myTitle)
    If iRet <> vbOK Then Exit Sub

    Application.StatusBar = "改ページ位置の確認中..."

    '画面更新の抑止
    Application.ScreenUpdating = False

    '自動改ページ位置を表示
    ActiveSheet.DisplayAutomaticPageBreaks = True

    '現在の余白、ページ数、改ページ位置を取得
    With ActiveSheet.PageSetup
        dfMargin(0) = .LeftMargin
        dfMargin(1) = .RightMargin
    End With
    iPageCount(0) = Application.ExecuteExcel4Macro("GET.DOCUMENT(50)")
    vVPageBreaks(0) = GetPageBreaks(0)
    vHPageBreaks(0) = GetPageBreaks(1)

    '左右の余白を入れ替えて、ページ数、改ページ位置を取得
    With ActiveSheet.PageSetup
        .LeftMargin = dfMargin(1)
        .RightMargin = dfMargin(0)
    End With
    iPageCount(1) = Application.ExecuteExcel4Macro("GET.DOCUMENT(50)")
    vVPageBreaks(1) = GetPageBreaks(0)
    vHPageBreaks(1) = GetPageBreaks(1)

    'ページ数、改ページ位置が変更された場合は処理を中断
    If iPageCount(0) <> iPageCount(1) Then GoTo exit_PageChange
    If Not VarArrayComp(vVPageBreaks(0), vVPageBreaks(1)) Then GoTo exit_PageChange
    If Not VarArrayComp(vHPageBreaks(0), vHPageBreaks(1)) Then GoTo exit_PageChange

    '左右の余白を元に戻して、ページ数、改ページ位置を取得
    With ActiveSheet.PageSetup
        .LeftMargin = dfMargin(0)
        .RightMargin = dfMargin(1)
    End With
    iPageCount(1) = Application.ExecuteExcel4Macro("GET.DOCUMENT(50)")
    vVPageBreaks(1) = GetPageBreaks(0)
    vHPageBreaks(1) = GetPageBreaks(1)

    'ページ数、改ページ位置が変更された場合は処理を中断
    If iPageCount(0) <> iPageCount(1) Then GoTo exit_PageChange
    If Not VarArrayComp(vVPageBreaks(0), vVPageBreaks(1)) Then GoTo exit_PageChange
    If Not VarArrayComp(vHPageBreaks(0), vHPageBreaks(1)) Then GoTo exit_PageChange

    '画面更新
    Application.StatusBar = False
    Application.ScreenUpdating = True

    '確認メッセージの表示
    iRet = MsgBox("ページ順(1,2,3,...)に、直ちに印刷します。", _
        vbExclamation Or vbOKCancel, myTitle)
    If iRet <> vbOK Then Exit Sub

    Application.ScreenUpdating = False

    '全ページを印刷
    For i = 1 To iPageCount(0)

        '左右の余白の設定
        With ActiveSheet.PageSetup
            .LeftMargin = dfMargin((Not i) And 1&)
            .RightMargin = dfMargin(i And 1&)
        End With

        '印刷
        bRet = ActiveSheet.PrintOut(from:=i, to:=i, copies:=1, _
            preview:=False, ActivePrinter:=Application.ActivePrinter, _
            printToFile:=False, collate:=False)
        If bRet = False Then GoTo exit_PrintError
    Next

    '左右の余白を元に戻す
    With ActiveSheet.PageSetup
        .LeftMargin = dfMargin(0)
        .RightMargin = dfMargin(1)
    End With

    Application.ScreenUpdating = True
    iRet = MsgBox("印刷が完了しました。", vbInformation, myTitle)
    Exit Sub

'改ページ位置が変更された場合の終了処理
exit_PageChange:
    Application.StatusBar = False
    Application.ScreenUpdating = True
    iRet = MsgBox("余白の変更により改ページ位置が変更されるため、印刷できません。", _
        vbExclamation, myTitle)
    With ActiveSheet.PageSetup
        .LeftMargin = dfMargin(0)
        .RightMargin = dfMargin(1)
    End With
    Exit Sub

'印刷がキャンセルされた場合の終了処理
exit_PrintError:
    Application.ScreenUpdating = True
    iRet = MsgBox("キャンセルまたはエラーにより、印刷が中断されました。", _
        vbExclamation, myTitle)
    With ActiveSheet.PageSetup
        .LeftMargin = dfMargin(0)
        .RightMargin = dfMargin(1)
    End With
    Exit Sub

'エラー発生時の処理
ErrorHandler:
    iRet = MsgBox(Error(Err) & " (" & Err & ")", vbExclamation, myTitle)
    With ActiveSheet.PageSetup
        .LeftMargin = dfMargin(0)
        .RightMargin = dfMargin(1)
    End With
    Application.StatusBar = False
    Exit Sub
End Sub


'改ページ位置を取得する関数
Function GetPageBreaks(ByVal iIndex As Integer) As Variant
    Dim sParam As String
    Dim vRet As Variant
    Dim i As Long, iCount As Long
    Dim a() As Long

    If iIndex = 0 Then sParam = "64" Else sParam = "65"
    vRet = Application.ExecuteExcel4Macro( _
        "COLUMNS(GET.DOCUMENT(" & sParam & "))")
    If VarType(vRet) = vbError Then
        ReDim a(1 To 1)
        a(1) = 0
        GetPageBreaks = a
        Exit Function
    End If
    iCount = vRet
    ReDim a(1 To iCount)
    For i = 1 To iCount
        a(i) = Application.ExecuteExcel4Macro( _
            "INDEX(GET.DOCUMENT(" & sParam & "),1," & CStr(i) & ")")
    Next
    GetPageBreaks = a
End Function


'Variant配列が同ーかチェックする関数
Function VarArrayComp(v1 As Variant, v2 As Variant) As Boolean
    Dim i As Long
    VarArrayComp = False
    If LBound(v1) = LBound(v2) Then
        If UBound(v1) = UBound(v2) Then
            For i = LBound(v1) To UBound(v1)
                If v1(i) <> v2(i) Then Exit Function
            Next
            VarArrayComp = True
        End If
    End If
End Function