Andy2483

回復 1# lkkchf


    謝謝前輩發表此主題
VB程式設定不顯示(關閉)工作表索引標籤目的為何?
如果是為了不讓使用者變換工作表,可以(隱藏其他工作表+保護活頁簿)或許可以有相似的效果

Andy2483

回復 4# lkkchf


    謝謝前輩回復,以下替代方案請試試看  (限管理者有權限(輸入密碼)的需求: 以 取消保護活頁簿的輸入密碼作管控)
PS:後學也想知道什麼代碼可以控制 選項>>進階選項 不讓使用者改變

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

下載 (59.65 KB)

2024-1-30 16:12

Andy2483

回復 7# lkkchf


    謝謝論壇,謝謝前輩再回復,一起學習
後學藉此帖學習到很多知識,學習方案如下,請前輩參考

下載 (81.79 KB)

2024-1-31 10:17

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

Andy2483

回復 9# lkkchf
20240131.zip (28.19 KB)

下載次數: 3

2024-1-31 13:13