VB Excel перед печатью рутина с многократной печатью

Question

В Excel я написал этот код для запуска определенной процедуры при каждом нажатии кнопки печати. Он меняет цвет листа на белый и возвращает его обратно после печати.

    Private Sub Workbook_BeforePrint(Cancel As Boolean)
Cancel = True
Application.EnableEvents = False

' change color to white
Range("A6:BD53").Interior.ColorIndex = 0

ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True

' AfterPrint_ change color back
 Range( _
        "G6:BD6,G8:AD8,AI8:BD8,AN11:AO11,Y11:Z11,F11:V11,K13:AK13,Q14:AK14,J15:T15,P38:P39"). _
        Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 49407
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With

Range( _
        "AB15:AE15,AU14:AX14,AU15:AX15,AU16:AX16,AA17:AC17,N24:W24,E28:O32,R28:U28,X28:AB31,AV37:BD37,V40:AL40,P41:U42,V43:AL43,V45:AL45,AV43:BD44" _
        ).Select
    Range("AV43").Activate
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With

Application.EnableEvents = True
End Sub

Это прекрасно работает, если я печатаю каждый лист по отдельности, но не работает, если я пытаюсь напечатать несколько листов одновременно, т.е. если я выбираю больше листов одновременно и печатаю их. В этом случае процедура запускается только для первого печатаемого листа, а не для остальных. Кто-нибудь знает, почему и что я могу сделать, чтобы это исправить?

Answer 1

Попробуйте использовать цикл For, чтобы просмотреть все выбранные листы:

Private Sub Workbook_BeforePrint(Cancel As Boolean)
Cancel = True
On Error GoTo Err
Application.EnableEvents = False

Dim ws As Worksheet
For Each ws In ActiveWindow.SelectedSheets

    ' change color to white
    ws.Range("A6:BD53").Interior.ColorIndex = 0

    ws.PrintOut Copies:=1, Collate:=True
    ' AfterPrint_ change color back
    With ws.Range("G6:BD6,G8:AD8,AI8:BD8,AN11:AO11,Y11:Z11,F11:V11,K13:AK13,Q14:AK14,J15:T15,P38:P39").Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 49407
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With

    With ws.Range("AV43").Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With

Next ws

Err:
Application.EnableEvents = True
End Sub

Как вы уже описали в комментариях, вы испытываете необычное поведение при печати. Вы можете использовать эту менее элегантную версию кода выше, это должно обойти вашу проблему:

Private Sub Workbook_BeforePrint(Cancel As Boolean)
Cancel = True
On Error GoTo Err
Application.EnableEvents = False

Dim ws As Worksheet
For Each ws In ActiveWindow.SelectedSheets

    ' change color to white
    ws.Range("A6:BD53").Interior.ColorIndex = 0

Next ws

ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True

For Each ws In ActiveWindow.SelectedSheets

    ' AfterPrint_ change color back
    With ws.Range("G6:BD6,G8:AD8,AI8:BD8,AN11:AO11,Y11:Z11,F11:V11,K13:AK13,Q14:AK14,J15:T15,P38:P39").Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 49407
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With

    With ws.Range("AV43").Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With

Next ws

Err:
Application.EnableEvents = True
End Sub