Question

我正在努力实现业务流程的自动化，但我遇到了一些麻烦。

到目前为止，我已经设法将下面的代码拼凑在一起，简而言之，它只是在单击命令按钮时将打开的工作表副本保存到我们的SharePoint站点。代码可能非常难看，但它有效，这是我的第一次尝试。

我创建了一个名为“Mandatory”的Range，我想添加一些代码来防止工作表保存并弹出一个MessageBox，要求用户完成所有必填字段，如果任何一个单元格内范围是空白的。 - 额外的功劳我想在可能的情况下以某种方式突出显示这些内容，但这是一个愿意，而不是必须在此时。

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

我已经设置了它使用的“强制”范围，但是我在Sub ForceDataEntry（）中出现错误，因为布尔

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

它给了我这个错误，为我尚未研究的照片道歉如何在我们在MAC上运行的这个Windows VM中打印屏幕...

Error Part 1

Error Part 2

Answer 1

额外信用：

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

版本A

如果单元格内部没有任何内容，则会格式化带有红色填充的单元格。（注意：这会将仅包含空格的单元格视为非空格。如果空格也应计为空白，请参阅下面的Version B。）

解释

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

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

版本B

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

如何向宏添加必需的单元格要求？

1 个答案: