返回列表 上一主題 發帖

[發問] 在VBA中，如何使用巨集隱藏部份工作表、及取消隱藏全部工作表？

lee88

帖子
12 
主題
0 
精華
0 
積分
62 
點名
0  
作業系統
win10 
軟體版本
office 365 
閱讀權限
20 
性別
女 
註冊時間
2022-2-1 
最後登錄
2022-12-29 
1# 跳轉到 »
發表於 2022-12-27 14:31 | 顯示全部帖子
回復 1# goner


  
  
依你的提問 如下圖片 在範圍內的運作看看

總表的程式碼如下
  1. Option Explicit
  2. Private Sub CommandButton1_Click()  '取消隱藏全部工作表的按鍵程式碼
  3.         Dim Sh As Worksheet
  4.         Application.ScreenUpdating = False
  5.         For Each Sh In Sheets
  6.             Sh.Visible = True
  7.         Next
  8.         Application.ScreenUpdating = True
  9. End Sub
  10. Private Sub Worksheet_Change(ByVal Target As Range)
  11.         If Target.Count = 1 Then HideSheet Target
  12. End Sub
  13. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  14.     If Target.Count = 1 Then HideSheet Target
  15. End Sub
  16. Sub HideSheet(Target As Range)
  17.     Dim Rng As Range, A組 As String, E As Variant
  18.     If Application.Intersect(Range("A1").CurrentRegion, Target) Is Nothing Then Exit Sub
  19.     Application.EnableEvents = False       '不觸動 Worksheet預設事件程式
  20.     On Error GoTo Err                                    '程式產生錯誤時移到 標記點
  21.     With Range("A1").CurrentRegion
  22.         Set Rng = Range(.Cells(2, Target.Column), .Cells(.Rows.Count, Target.Column))
  23.     End With
  24.     A組 = "總表"    'A組 = "總表,表1,表2,表3"    ' ***可修改 必須顯示的工作表
  25.     For Each E In Rng
  26.         A組 = A組 & "," & E
  27.         Set Target = E
  28.         Debug.Print TypeName(Sheets(E.Value)) ' '測試儲存格的工作表名稱是否存
  29.     Next
  30.     A組 = "," & A組 & "," '
  31.     Application.ScreenUpdating = False
  32.     For Each E In Sheets
  33.             E.Visible = InStr(UCase(A組), "," & UCase(E.Name) & ",") > 0
  34.             '* 比對完全相同的工作表名稱 ->>     "," & UCase(i.Name) & ","
  35.     Next
  36.     Application.ScreenUpdating = True
  37.     Application.EnableEvents = True      '回復觸動 Worksheet預設事件程式
  38.     Exit Sub
  39. Err:                          '處理程式碼的錯誤
  40.     MsgBox IIf(Target <> "", "  找不到 工作表 [" & Target & "]", Target.Address(0, 0) & "沒有輸入....")
  41.     Application.EnableEvents = True      '回復觸動 Worksheet預設事件程式
  42. End Sub
複製代碼

TOP

        靜思自在 : 真正的愛心，是照顧好自己的這顆心。
返回列表 上一主題