Запретить пользователям печать, если ячейки не заполнены

Question

Мне нужно создать макрос для , чтобы пользователи не печатали , если определенные ячейки не заполнены.

Я нашел этот код в Интернете и немного изменил его в соответствии со своими предпочтениями, но я не уверен, где ввести код activesheet_print, чтобы начать, а затем остановить печать, если какой-либо из диапазонов пуст.Пожалуйста, помогите мне, ребята!

Sub QuickPrint()

Dim Start As Boolean
Dim rng As Range
Dim Prompt As String
Dim RngStr As String
Dim Cell As Range
'set your ranges here to suit your needs.

Set ws = Sheets("Form")
With ws
Set rng = Union(.Range("E2:E5"), .Range("E9"), .Range("V9"), .Range("E10:E11"), .Range("M10:M11"), .Range("V10:V11"), .Range("H15"), .Range("H17"), .Range("H19"), .Range("H21"), .Range("H23"), .Range("M35"))
End With
'prompt message if there are blank cells
Prompt = "Please ensure all cells are filled."
Start = True


For Each Cell In rng
If Cell.Value = vbNullString Then
Cell.Interior.ColorIndex = 6 'yellow
Cancel = True
If Start Then RngStr = RngStr & "X" & vbCrLf
Start = False
RngStr = RngStr
Else
Cell.Interior.ColorIndex = 0 'no color
End If
Next

If RngStr <> "" Then
RngStr = Left$(RngStr, Len(RngStr) - 1)
Cancel= True
Else
ActiveSheet.PrintOut
End if

If RngStr <> "" Then
MsgBox Prompt, vbCritical, "Incomplete Data"
End If

End Sub

Спасибо всем, кто помог.Код работает прямо сейчас.Не стесняйтесь использовать его, если понадобится.Ура!

Answer 1

Несколько вещей, которые я заметил, просматривая ваш код.

Dim rng, rng1, rng2, rng3, rng4, rng5, rng6, rng7, rng8, rng9, rng10, rng11, rng12 As Range

Из всех этих диапазонов только rng12 является фактическим диапазоном, остальные - Variant/Object/Range.

Я бы предложил указать каждую переменную в качестве диапазона или создать отдельный диапазон -

Dim myRange As Range, ws As Worksheet
Set ws = Sheets("Form")
With ws
    Set myRange = Union(.Range("E2:E5"), .Range("E9"), .Range("V9"), .Range("E10:E11"), .Range("M10:M11"), .Range("V10:V11"), .Range("H15"), .Range("H17"), .Range("H19"),.Range("H21"), .Range("H23"), .Range("M35"))
End With

Я внес некоторые незначительные изменения в структуру вашего финального блока if, чтобы определить, должен ли печататься сбой, проверено и работает нормально.Полный полный код ниже -

Option Explicit
Private Sub Workbook_BeforePrint(Cancel As Boolean)
    Dim myRange As Range, ws As Worksheet, start As Boolean, prompt As String, rngStr As String, cell As Range

    ' build up your range
    Set ws = Sheets("Form")
    With ws
        Set myRange = Union(.Range("E2:E5"), .Range("E9"), .Range("V9"), .Range("E10:E11"), .Range("M10:M11"), .Range("V10:V11"), .Range("H15"), .Range("H17"), .Range("H19"), .Range("H21"), .Range("H23"), .Range("M35"))
    End With

    'prompt message if there are blank cells
    prompt = "Please ensure all cells are filled."
    start = True


    For Each cell In myRange
        If cell.Value = vbNullString Then cell.Interior.ColorIndex = 6 'color yellow
        If start And cell.Value = vbNullString Then
            rngStr = rngStr & "X" & vbCrLf
            start = False
            rngStr = rngStr
        Else
            cell.Interior.ColorIndex = 0 '** no color
        End If
    Next cell

    If rngStr <> "" Then
        rngStr = Left$(rngStr, Len(rngStr) - 1)
        If rngStr <> "" Then
            MsgBox prompt, vbCritical, "Incomplete Data"
            Cancel = True
        End If
    End If
End Sub

Вы хотите поместить этот код в раздел ThisWorkbook вашего VBAProject.

Если вы хотите проверить, защищен ли в первую очередь лист, естьВы можете использовать два подхода.

Вы можете отредактировать построение диапазона следующим образом -

' build up your range
Set ws = Sheets("Form")
If ws.ProtectContents Then Exit Sub
With ws
    Set myRange = Union(.Range("E2:E5"), .Range("E9"), .Range("V9"), .Range("E10:E11"), .Range("M10:M11"), .Range("V10:V11"), .Range("H15"), .Range("H17"), .Range("H19"), .Range("H21"), .Range("H23"), .Range("M35"))
End With

Или вы можете создать дополнительную функцию в отдельном модуле (допускает многократное использование) &используйте следующее -

' Separate module 'Module1'
Option Explicit

Public Function IsSheetLocked(sheet As Worksheet) As Boolean
    If sheet.ProtectContents Then IsSheetLocked = True
End Function

и обновите ваш основной саб - до -

' build up your range
Set ws = Sheets("Form")
If IsSheetLocked(ws) Then Exit Sub
With ws
    Set myRange = Union(.Range("E2:E5"), .Range("E9"), .Range("V9"), .Range("E10:E11"), .Range("M10:M11"), .Range("V10:V11"), .Range("H15"), .Range("H17"), .Range("H19"), .Range("H21"), .Range("H23"), .Range("M35"))
End With

Edit1: исправлена ​​логика для устранения проблемы с ошибкой после правильного заполнения значений.

Edit2: добавлен дополнительный шаг, чтобы проверить, заблокирован ли лист