|
有時(shí)，必須確保用戶在打開工作簿時(shí)啟用宏，否則就不能實(shí)現(xiàn)工作簿的效果。由于無法使用宏去打開宏，因此需要一種確保用戶啟用宏的技術(shù)。下面講解的方法隱藏除“歡迎”工作表（告訴用戶啟用宏）之外的所有工作表，并在每次保存工作簿時(shí)強(qiáng)制執(zhí)行該工作表。如果用戶在啟用了宏的情況下打開工作簿，則宏將不會(huì)隱藏所有工作表。還可以使用Excel的 VeryHidden屬性來實(shí)現(xiàn)工作表的隱藏，這意味著不能使用Excel的菜單來取消隱藏工作表。但是，這只會(huì)影響該工作簿，因此用戶可以使用另一個(gè)工作簿中的宏取消隱藏所有工作表。但是，如果用戶非常熟練，他們總是可以始終進(jìn)入你的文件中。注意：為防止某些事件循環(huán)問題，此代碼需要覆蓋Excel內(nèi)置的Save事件，并且還需要復(fù)制Excel的“工作簿已更改，您要保存”提示和操作，代碼負(fù)責(zé)所有這些工作。但是，在關(guān)閉文件時(shí)確實(shí)會(huì)產(chǎn)生一個(gè)非常小的問題。如果用戶嘗試退出該應(yīng)用程序，它將關(guān)閉工作簿，而不是Excel。再次退出將完全關(guān)閉Excel。 下面是代碼： Const WelcomePage = '歡迎' Private Sub Workbook_BeforeClose(Cancel As Boolean) '關(guān)閉事件以阻止不必要的循環(huán) Application.EnableEvents = False '評(píng)估是否保存工作簿并模擬默認(rèn)的提示信息 With ThisWorkbook If Not .Saved Then Select Case MsgBox('你想保存對(duì) '' &.Name & '' 工作簿所做的變化嗎?', _ vbYesNoCancel + vbExclamation) Case Is = vbYes '調(diào)用自定義的保存程序 Call CustomSave Case Is = vbNo '不保存 Case Is = vbCancel '設(shè)置過程來取消關(guān)閉 Cancel = True End Select End If '如果單擊取消, 重新打開事件并取消關(guān)閉, '否則不保存改變而關(guān)閉工作簿. 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) '關(guān)閉事件以阻止不必要的循環(huán) Application.EnableEvents = False '調(diào)用自定義的保存程序并設(shè)置工作簿的saved屬性為true '(取消常規(guī)的保存) Call CustomSave(SaveAsUI) Cancel = True '重新打開事件并設(shè)置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 '關(guān)閉屏幕更新 Application.ScreenUpdating = False '設(shè)置為活動(dòng)工作表 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 '恢復(fù)文件還原到用戶所在的位置 Call ShowAllSheets aWs.Activate '恢復(fù)屏幕更新 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. 工作簿中應(yīng)該有一個(gè)名為“歡迎”的工作表，否則你要將代碼前面的常量WelcomePage設(shè)置為用戶沒有啟用宏時(shí)的提示工作表名稱。 注：本文的代碼整理自vbaexpress.com。 |
|
|
