エクセルのマクロでシートを表示させる

こんにちは。

最初、標準モジュールとクラスモジュールに貼りつけます。

このマクロの使い方は、最初に、SettingCheckBoxes　で、CheckBoxにインスタンスを設けます。後は、自動的に組み込まれています。ただし、一旦設定されたCheckBox は、マクロを変更したりすると、設定が壊れることがあります。その場合は、再設定をしてください。シートの数が多くなっても、CheckBoxに組み込まれます。

Sheet1 もしくは、最初のシートに、CheckBox を置いてください。そのシート自体は、表示・非表示は出来ません。後は、CheckBoxの数とシートの数を合わせてください。そうしないと、エラー検出モードでは、設定は出来ません。

もし、シートの数とCheckBox の数を合わせないようでしたら、SettingCheckBoxes の　ErrorFree のところに、True を入れてください。

　Const ErrorFree As Boolean = False 'エラー検出モード

一旦設定されたら、シート等を変更しない限りは、再設定は不要です。
'-------------------------------------------
'標準モジュール

Public myClass() As Class1
Sub Auto_Open()
　　Call ShVisibleRetrieval
　　Call CheckBoxesClsssSetting
End Sub
Sub CheckBoxesClsssSetting()
　　'Class 設定
　　Dim cnt As Variant
　　Dim i As Long
　　For Each cnt In ActiveSheet.OLEObjects
　　　　On Error Resume Next
　　　　If TypeOf cnt.Object Is MSForms.CheckBox Then
　　　　　　ReDim Preserve myClass(i)
　　　　　　Set myClass(i) = New Class1
　　　　　　Set myClass(i).Chk = cnt.Object
　　　　　　i = i + 1
　　　　End If
　　Next
　　On Error GoTo 0
End Sub
Sub ShVisibleRetrieval()
　　'シートの状態をチェックボックスに反映
　　Dim i As Long
　　Dim cnt As Variant
　　Dim n As String
　　i = 1
　　On Error Resume Next
　　For Each cnt In ActiveSheet.OLEObjects
　　　　If TypeOf cnt.Object Is MSForms.CheckBox Then
　　　　　　n = cnt.Object.Caption
　　　　　　If Worksheets(n).Visible <> xlSheetVisible Then
　　　　　　　　cnt.Object.Value = False
　　　　　　Else
　　　　　　　　cnt.Object.Value = True
　　　　　　End If
　　　　End If
　　　　If Err.Number > 0 Then Exit Sub
　　Next
　　On Error GoTo 0
End Sub
'=========================================
Sub SettingCheckBoxes()
　　'チェックボックスの設定
　　'シート名をチェックボックス名に反映
　　Dim i As Long
　　Dim shCnt As Long
　　Dim cnt As Variant
　　Dim e As Integer
　　Const ErrorFree As Boolean = False 'エラー検出モード
　　'チェックボックスを置いたシートは連動しない
　　shCnt = ThisWorkbook.Worksheets.Count
　　i = 1
　　On Error Resume Next
　　For Each cnt In ActiveSheet.OLEObjects
　　　　If TypeOf cnt.Object Is MSForms.CheckBox Then
　　　　　　Do Until ActiveSheet.Index <> i: i = i + 1: Loop
　　　　　　　　cnt.Object.Caption = Worksheets(i).Name
　　　　　　　　i = i + 1
　　　　　　End If
　　　　　　If Err.Number > 0 Then e = Err.Number: GoTo EndLine
　　　　Next
　　　　On Error GoTo 0
EndLine:
　　　　If ErrorFree = False Then
　　　　　　If shCnt > (i - 1) Then
　　　　　　　　MsgBox "コントロールの数が足りません。" & vbCrLf & _
　　　　　　　　"コントロールを増やしてやり直したほうがよいです。", vbQuestion
　　　　　　ElseIf shCnt < (i - 1) Then
　　　　　　　　MsgBox "コントロールを残して、終了しました。" & vbCrLf & _
　　　　　　　　"不要なコントロールを削除してください。", vbInformation
　　　　　　Else
　　　　　　　　Call Auto_Open
　　　　　　　　MsgBox "設定が終わりましたので、使用できます。", vbInformation
　　　　　　End If
　　　　Else
　　　　　　If e = 9 Then
　　　　　　　　Call Auto_Open
　　　　　　　　MsgBox "コントロールの数が多すぎますが、設定されました。", vbExclamation
　　　　　　ElseIf e > 0 Then
　　　　　　　　Call Auto_Open
　　　　　　　　MsgBox "エラーが発生しているので、不具合があるかもしません。", vbExclamation
　　　　　　Else
　　　　　　　　Call Auto_Open
　　　　　　　　MsgBox "設定が終わりました。", vbInformation
　　　　　　End If
　　　　End If
End Sub

'=========================================

'-------------------------------------------
'クラスモジュール

Public WithEvents Chk As MSForms.CheckBox

Private Sub Chk_Click()
　 ThisWorkbook.Worksheets(Chk.Caption).Visible = IIf(Chk.Value, xlSheetVisible, xlSheetHidden)
End Sub

投稿日時 - 2010-02-10 11:23:35

シート上に置く事が出来るチェックボックにはコントロールボックスとフォームの2種類がありますがどちらでしょう？

とりあえず、コントロールボックスの方だと仮定して回答いたしますが、チェックボックのコメントがそのままシート名になっているのでしたら、↓こんな感じでどうでしょう。

Private Sub CheckBox1_Click()
　Sheets(CheckBox1.Caption).Visible = CheckBox1.Value
End Sub

「CheckBox1」の部分は適当に修正してください。

投稿日時 - 2010-02-10 10:49:10