如何向宏添加强制单元格要求？

Question

我正在尝试使业务流程自动化，但我运行遇到了一些麻烦。

到目前为止，我已经设法拼凑了以下代码，简而言之，它所做的就是在单击命令按钮后将打开的工作表的副本保存到我们的 SharePoint 站点。该代码可能非常丑陋，但它可以工作，这是我的第一次尝试。

我创建了一个名为 "Mandatory" 的范围，我想添加一些代码来阻止工作表保存，并弹出一个消息框，要求用户完成所有必填字段（如果有）范围内的单元格为空白。 -- 额外的功劳如果可能的话，我想以某种方式强调这些，但在这一点上这是一个愿望而不是必须的。

Sub Save_Worksheet()

ActiveSheet.Unprotect

'Variables for saving worksheet to SharePoint, establishing correct file name & extension

Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim mbResult As Integer

 With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With

Set Sourcewb = ActiveWorkbook

ActiveSheet.Copy
Set Destwb = ActiveWorkbook


'Establish File Extension type
With Destwb
    If Val(Application.Version) < 12 Then

        FileExtStr = ".xls": FileFormatNum = -4143
    Else

        If Sourcewb.Name = .Name Then
            With Application
                .ScreenUpdating = True
                .EnableEvents = True
            End With
        Else
            FileExtStr = ".xlsm": FileFormatNum = 52
        End If
    End If
End With

'Save the new workbook and close it
TempFilePath = ("\linktomysharepoint") & "\"
TempFileName = Range("A1").Text

'Confirm Submission
mbResult = MsgBox("This submission cannot be undone. Would you like to continue?", _
vbYesNo)

Select Case mbResult
Case vbNo
    Exit Sub
End Select

'Build .SaveAs file Name based on variables established previously
With Destwb
    .SaveAs TempFilePath & TempFileName & FileExtStr, 
FileFormat:=FileFormatNum
    .Close savechanges:=False
End With

With Application
    .ScreenUpdating = True
    .EnableEvents = True
End With

Application.DisplayAlerts = True
ThisWorkbook.Activate

'Display successful submission message
MsgBox ("Thank you, your assessment has been successfully submitted.")

ActiveSheet.Protect

End Sub

我一直在玩弄以下内容，但我似乎无法让它正常工作，我在这里找到了它：https://excelribbon.tips.net/T009574_Requiring_Input.html

我已经设置了它使用的 "Mandatory" 范围，但我在 Sub ForceDataEntry() As Boolean

处收到错误

Sub ForceDataEntry() As Boolean

Dim rng As Range
Dim c As Variant
Dim rngCount As Integer
Dim CellCount As Integer

Set rng = Range("Mandatory")
rngCount = rng.Count

CellCount = 0
For Each c In rng
    If Len(c) > 0 Then
        CellCount = CellCount + 1
    End If
Next c
ForceDataEntry = False
If CellCount <> rngCount Then
    ForceDataEntry = True
End If

End Sub

我把它剪成这样：

Sub Save_Worksheet()

ActiveSheet.Unprotect

'Variables for saving worksheet to SharePoint, establishing correct file name & extension
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim mbResult As Integer

'Variables for Mandatory Requirement
Dim rng As Range
Dim c As Variant
Dim rngCount As Integer
Dim CellCount As Integer

 With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With

Set Sourcewb = ActiveWorkbook

ActiveSheet.Copy
Set Destwb = ActiveWorkbook


 Set rng = Range("Mandatory")
rngCount = rng.Count

CellCount = 0
For Each c In rng
    If Len(c) > 0 Then
        CellCount = CellCount + 1
    End If
Next c
ForceDataEntry = False
If CellCount <> rngCount Then
    ForceDataEntry = True
End If


'Establish File Extension type
With Destwb
    If Val(Application.Version) < 12 Then

        FileExtStr = ".xls": FileFormatNum = -4143
    Else

        If Sourcewb.Name = .Name Then
            With Application
                .ScreenUpdating = True
                .EnableEvents = True
            End With

            'MsgBox "Your answer is NO in the security dialog"
            'Exit Sub

        Else
            FileExtStr = ".xlsm": FileFormatNum = 52
        End If
    End If
End With

'Save the new workbook and close it
TempFilePath = ("\mysharepoint") & "\"
TempFileName = Range("A1").Text

'Confirm Submission
mbResult = MsgBox("This submission cannot be undone. Would you like to continue?", _
vbYesNo)

Select Case mbResult
Case vbNo
    Exit Sub
End Select

'Build .SaveAs file Name based on variables established previously
With Destwb
    .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
    .Close savechanges:=False
End With

With Application
    .ScreenUpdating = True
    .EnableEvents = True
End With

 Application.DisplayAlerts = True
ThisWorkbook.Activate

'Display successful submission message
MsgBox ("Thank you, your assessment has been successfully submitted.")

ActiveSheet.Protect

End Sub

它给了我这个错误，对于我尚未在 windows VM 中打印屏幕的照片表示歉意，我们运行在 MAC.. .

Error Part 1

Error Part 2

Answer 1

加分项：

您可以在强制范围内设置一些条件格式，这将根据单元格是否为空而改变。

版本 A

如果里面没有任何内容，这将格式化一个红色填充的单元格。（注意： 这会将只有白色 space 的单元格视为非空白。如果白色-space 也应算作空白，请参见下面的 Version B .)

说明

请注意，由于方程式引用调用 A1（没有 $ 来锚定引用），这是应用范围中的第一个单元格，条件格式将检查每个单元格如果它是空白的。

如果方程式改为 =ISBLANK($A1)，那么如果 A1 为空白，则应用范围第 1 行中的所有单元格都将使用红色填充进行格式化。另一方面，如果等式是 =ISBLANK(A2)，则每个单元格的格式都将用红色填充 如果其下方行中的单元格 为空白。这是因为条件格式的计算就像公式仅适用于应用范围内的第一个单元格一样，然后扩展以覆盖整个应用范围，单元格引用在相同的范围内移动它们在您通过拖动展开的单元格内移动方程式的方式。

版本 B

与 Version A 下的 Explanation 部分中的推理相同。主要区别在于条件格式中输入的实际方程式。

如何向宏添加强制单元格要求？

How do I add a mandatory cells requirement to a macro?

excel

vba

excel-2010