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。