组合强制用户启用宏的代码和使单元格成为必需的代码

时间:2017-02-18 09:36:51

标签: vba excel-vba excel

非常感谢A.S.H早些时候帮助我解决了这个问题。

现在,我试图显示一个启动表,告诉用户启用宏以访问工作簿。计划是在BeforeClose事件期间保存文件,并且可以看到防溅板和其他工作表。在Open事件期间,防溅板将被隐藏,其他板将被显示。

因此,用户只有在打开禁用宏的文件时才会看到启动表。但是,使用下面的代码,它看起来好像使得启动工作表可见并且其余部分非常隐藏的例程正在运行。我哪里出错?

Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim rs As Object, ws As Object
Dim Ans As Integer
Dim target As Range, r As Range
Set rs = Sheets("Report")
If Me.Saved = False Then
    Do
        Ans = MsgBox("Do you want to save the changes you made to '" & _
            Me.Name & "'?", vbQuestion + vbYesNoCancel)
        Select Case Ans
            Case vbYes
                With rs
                    Set target = .Range("B5:R" & .Cells(.Rows.Count, 2).End(xlUp).Row)
                End With
                target.Value = Application.Trim(target.Value)
                For Each r In target.Rows
                    If Not IsEmpty(r.Cells(1)) And Application.CountIf(r, "") > 0 Then
                        Cancel = True
                        r.Parent.Activate: r.Activate
                        MsgBox ("Please confirm all required fields have been completed")
                        Exit Sub
                    End If
                Next
                Application.ScreenUpdating = False
                Sheets("Reminder").Visible = xlSheetVisible
                For Each ws In ThisWorkbook.Worksheets
                    If ws.Name <> "Reminder" Then
                        ws.Visible = xlSheetVeryHidden
                    End If
                Next ws
                ActiveWorkbook.Save
                For Each ws In ThisWorkbook.Worksheets
                    If ws.Name <> "Reminder" Then
                        ws.Visible = xlSheetVisible
                    End If
                Next ws
                Sheets("Reminder").Visible = xlSheetVeryHidden
                ThisWorkbook.Saved = True
                Application.ScreenUpdating = True
            Case vbNo
                Me.Saved = True
            Case vbCancel
                Cancel = True
                Exit Sub
        End Select
    Loop Until ThisWorkbook.Saved = True
End If
End Sub

1 个答案:

答案 0 :(得分:1)

如果您遇到屏幕问题,可能是由于在此处和其他宏中对Application.ScreenUpdating进行了一些错误的操作。在这一个中,错误是您首先将其设置为False然后Exit Sub而不将其恢复为True

此外,由于您的例程只进行计算(检查)并且不更改单元格值,因此禁用Application.ScreenUpdating没有意义。

另一方面,我认为检查空单元格的例程可以大大简化。

Function dataIsValid() As Boolean
    Dim target As Range, r As Range
    With ActiveSheet ' <-- May be better change to some explicit sheet name
        Set target = .Range("B5:R" & .Cells(.Rows.Count, 2).End(xlUp).Row)
    End With
    target.value = Application.Trim(target.value) ' <-- trim the whole range
    For Each r In target.Rows
        If Not IsEmpty(r.Cells(1)) And Application.CountIf(r, "") Then
            r.Parent.Activate: r.Activate ' <-- Show erroneous row
            MsgBox ("Please confirm all required fields have been completed")
            Exit Function
        End If
    Next
    dataIsValid = True
End Function

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Cancel = Not dataIsValid
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Cancel = Not dataIsValid
End Sub