Sub 不顯示_工作表索引標籤()
Dim xS As Worksheet
If ActiveWorkbook.ProtectWindows Or ActiveWorkbook.ProtectStructure Then Exit Sub
For Each xS In Worksheets
If Not xS Is ActiveSheet Then xS.Visible = False
Next
ActiveWorkbook.Protect "0000", Structure:=True, Windows:=True
ActiveWindow.DisplayWorkbookTabs = False
End Sub
Sub 顯示_工作表索引標籤()
Dim xS As Worksheet, acS As Worksheet
If ActiveWorkbook.ProtectWindows Or ActiveWorkbook.ProtectStructure Then
MsgBox "請先取消保護活頁簿!": Exit Sub
End If
Set acS = ActiveSheet
For Each xS In Worksheets
xS.Visible = True
Next
acS.Activate
ActiveWindow.DisplayWorkbookTabs = True
End Sub
[attach]37380[/attach]作者: lkkchf 時間: 2024-1-30 17:05
Option Explicit
#If Win64 Then
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
Private Declare PtrSafe Function timeSetEvent Lib "winmm.dll" (ByVal uDelay As Long, ByVal uResolution As Long, ByVal lpFunction As LongPtr, ByVal dwUser As LongPtr, ByVal uFlags As Long) As Long
Private Declare PtrSafe Function timeKillEvent Lib "winmm.dll" (ByVal uID As Long) As Long
#Else
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function timeSetEvent Lib "winmm.dll" (ByVal uDelay As Long, ByVal uResolution As Long, ByVal lpFunction As Long, ByVal dwUser As Long, ByVal uFlags As Long) As Long
Private Declare Function timeKillEvent Lib "winmm.dll" (ByVal uID As Long) As Long
#End If
Private Const Em_SetPassWordChar = &HCC
Dim lTimeID As Long
Const pswdInputBoxTitle = "pswdInputBox"
Sub TimeProc(ByVal uID As Long, ByVal uMsg As Long, ByVal dwUser As Long, ByVal dw1 As Long, ByVal dw2 As Long)
Dim hwd As LongPtr
hwd = FindWindow("#32770", pswdInputBoxTitle)
If hwd <> 0 Then hwd = FindWindowEx(hwd, 0, "Edit", vbNullString): SendMessage hwd, Em_SetPassWordChar, 42, 0: timeKillEvent lTimeID
End Sub
Function pswdInputBox() As Variant
lTimeID = timeSetEvent(10, 50, AddressOf TimeProc, 1, 1)
pswdInputBox = InputBox(Prompt:="請輸入管理員密碼", Title:=pswdInputBoxTitle)
End Function
'=========================================================
Sub 工作表索引標籤_S_H()
Dim xS As Worksheet, acS As Worksheet
If ActiveWorkbook.ProtectWindows Or ActiveWorkbook.ProtectStructure Then
If pswdInputBox <> "12345" Then Exit Sub
ActiveWorkbook.Unprotect "0000"
Set acS = ActiveSheet
For Each xS In Worksheets: xS.Visible = True: Next
acS.Activate: ActiveWindow.DisplayWorkbookTabs = True: Exit Sub
End If
For Each xS In Worksheets: xS.Visible = IIf(Not xS Is ActiveSheet, False, True): Next
ActiveWorkbook.Protect "0000", Structure:=True, Windows:=True
ActiveWindow.DisplayWorkbookTabs = False
End Sub
'=========================================================
Sub 顯示_工作表1()
Dim xS As Worksheet, acS As Worksheet
ActiveWorkbook.Unprotect "0000": Set acS = Sheets("工作表1"): acS.Visible = True: acS.Activate
For Each xS In Worksheets: xS.Visible = IIf(Not xS Is acS, False, True): Next
ActiveWorkbook.Protect "0000", Structure:=True, Windows:=True: ActiveWindow.DisplayWorkbookTabs = False
End Sub
'=========================================================
Sub 顯示_工作表2()
Dim xS As Worksheet, acS As Worksheet
ActiveWorkbook.Unprotect "0000": Set acS = Sheets("工作表2"): acS.Visible = True: acS.Activate
For Each xS In Worksheets: xS.Visible = IIf(Not xS Is acS, False, True): Next
ActiveWorkbook.Protect "0000", Structure:=True, Windows:=True: ActiveWindow.DisplayWorkbookTabs = False
End Sub
'=========================================================
Sub 顯示_工作表3()
Dim xS As Worksheet, acS As Worksheet
ActiveWorkbook.Unprotect "0000": Set acS = Sheets("工作表3"): acS.Visible = True: acS.Activate
For Each xS In Worksheets: xS.Visible = IIf(Not xS Is acS, False, True): Next
ActiveWorkbook.Protect "0000", Structure:=True, Windows:=True: ActiveWindow.DisplayWorkbookTabs = False
End Sub
參考: https://forum.twbts.com/viewthre ... amp;page=1#pid29595作者: lkkchf 時間: 2024-1-31 12:55
