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

我对您的final 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

您要将这段代码放在VBAProject的ThisWorkbook部分中。

如果要先检查工作表是否受到保护，则可以采用两种方法。

您可以按照以下步骤编辑范围构建-

' 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：添加了额外的步骤来检查工作表是否已锁定

如果未填充单元格，则阻止用户打印

1 个答案: