- 帖子
- 1446
- 主題
- 40
- 精華
- 0
- 積分
- 1470
- 點名
- 0
- 作業系統
- Windows 7
- 軟體版本
- Excel 2010 & 2016
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2020-7-15
- 最後登錄
- 2024-10-21
|
8#
發表於 2024-1-31 09:57
| 只看該作者
本帖最後由 Andy2483 於 2024-1-31 10:18 編輯
回復 7# lkkchf
謝謝論壇,謝謝前輩再回復,一起學習
後學藉此帖學習到很多知識,學習方案如下,請前輩參考
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 |
|
