VBA代码库10：强制用户启用宏

有时，必须确保用户在打开工作簿时启用宏，否则就不能实现工作簿的效果。由于无法使用宏去打开宏，因此需要一种确保用户启用宏的技术。下面讲解的方法隐藏除“欢迎”工作表（告诉用户启用宏）之外的所有工作表，并在每次保存工作簿时强制执行该工作表。如果用户在启用了宏的情况下打开工作簿，则宏将不会隐藏所有工作表。还可以使用Excel的 VeryHidden属性来实现工作表的隐藏，这意味着不能使用Excel的菜单来取消隐藏工作表。但是，这只会影响该工作簿，因此用户可以使用另一个工作簿中的宏取消隐藏所有工作表。但是，如果用户非常熟练，他们总是可以始终进入你的文件中。注意：为防止某些事件循环问题，此代码需要覆盖Excel内置的Save事件，并且还需要复制Excel的“工作簿已更改，您要保存”提示和操作，代码负责所有这些工作。但是，在关闭文件时确实会产生一个非常小的问题。如果用户尝试退出该应用程序，它将关闭工作簿，而不是Excel。再次退出将完全关闭Excel。

下面是代码：

Const WelcomePage = '欢迎'

Private Sub Workbook_BeforeClose(Cancel As Boolean)

   '关闭事件以阻止不必要的循环

    Application.EnableEvents = False

   '评估是否保存工作簿并模拟默认的提示信息

    With ThisWorkbook

        If Not .Saved Then

            Select Case MsgBox('你想保存对 '' &.Name & '' 工作簿所做的变化吗?', _

                vbYesNoCancel + vbExclamation)

            Case Is = vbYes

                 '调用自定义的保存程序

                Call CustomSave

            Case Is = vbNo

                 '不保存

            Case Is = vbCancel

                 '设置过程来取消关闭

                Cancel = True

            End Select

        End If

        '如果单击取消, 重新打开事件并取消关闭,

        '否则不保存改变而关闭工作簿.

        If Not Cancel = True Then

            .Saved = True

            Application.EnableEvents = True

            .Close savechanges:=False

        Else

            Application.EnableEvents = True

        End If

    End With

End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

   '关闭事件以阻止不必要的循环

    Application.EnableEvents = False

   '调用自定义的保存程序并设置工作簿的saved属性为true

   '(取消常规的保存)

    Call CustomSave(SaveAsUI)

    Cancel = True

   '重新打开事件并设置saved属性为true

    Application.EnableEvents = True

    ThisWorkbook.Saved = True

End Sub

Private Sub Workbook_Open()

    '取消隐藏所有工作表

    Application.ScreenUpdating = False

    Call ShowAllSheets

    Application.ScreenUpdating = True

End Sub

Private Sub CustomSave(Optional SaveAs As Boolean)

    Dim ws As Worksheet, aWs As Worksheet,newFname As String

   '关闭屏幕更新

    Application.ScreenUpdating = False

   '设置为活动工作表

    Set aWs = ActiveSheet

   '隐藏所有工作表

    Call HideAllSheets

   '直接保存工作簿或提示另存为文件名

    If SaveAs = True Then

        newFname =Application.GetSaveAsFilename( _

        fileFilter:='Excel Files (*.xls*),*.xls*')

        If Not newFname = 'False'Then ThisWorkbook.SaveAs newFname

    Else

        ThisWorkbook.Save

    End If

   '恢复文件还原到用户所在的位置

    Call ShowAllSheets

    aWs.Activate

   '恢复屏幕更新

    Application.ScreenUpdating = True

End Sub

Private Sub HideAllSheets()

   '隐藏除'欢迎'外的所有工作表

    Dim ws As Worksheet

    Worksheets(WelcomePage).Visible =xlSheetVisible

    For Each ws In ThisWorkbook.Worksheets

        If Not ws.Name = WelcomePage Thenws.Visible = xlSheetVeryHidden

    Next ws

    Worksheets(WelcomePage).Activate

End Sub

Private Sub ShowAllSheets()

   '显示除'欢迎'外的所有工作表

    Dim ws As Worksheet

    For Each ws In ThisWorkbook.Worksheets

        If Not ws.Name = WelcomePage Thenws.Visible = xlSheetVisible

    Next ws

    Worksheets(WelcomePage).Visible =xlSheetVeryHidden

End Sub

说明：

1. 代码放置在ThisWorkbook代码模块中。

2. 工作簿中应该有一个名为“欢迎”的工作表，否则你要将代码前面的常量WelcomePage设置为用户没有启用宏时的提示工作表名称。

注：本文的代码整理自vbaexpress.com。