category name » page title date

複数の窓を開けたり閉じたり

「窓を開けたり閉じたり」では、一定幅の列で構成されたひとつの窓をワークシートの左側に開けたり閉じたりしましたが、もうちょっと複雑な窓を複数開閉してみようと、がんばってみました。まず、その使い方から説明します。

一覧表の場所の確保

まず表の場所を確保する

準備。窓の数がいくつあるかわからない、それぞれの窓がいくつの列で構成されていて、それぞれの列の幅がどれだけなのかがわからない、それでは困るというので、それを記録するための表（のスペース）をまず作ります。
ここでは、"Const"という名前のワークシートにその場所を確保しました。適当なセルに"DaftarWindow"という名前をつけています。それが（表側を含めた）一覧表の左肩のセルになります。表側の右側以降に、後で自動的に値が記録されます。

DaftarWindow の右に操作する窓の数だけの列を、ColumnWidth の欄の下にもっとも列数の多い窓の列数分 -1 だけの行を、空間として確保しておきます。
表のワークシート名は tableSheetName に、表左肩のセル名は tableCellName に、コードの先頭で定数として宣言してあります。

それぞれの窓の中身の作成と登録

次に、窓を開けるワークシートに、窓の内容を作り込みます。
まず、窓を開け閉めするタブを窓を設ける場所の左端に貼り付けます。エクセルの標準図形として用意されている ShapeRound1Rectangle(「四角形: 1 つの角を丸める」)を回転させて使いました。中の文字は任意ですが、Shape名は Tab-1、Tab-2・・・のようにしておきます。ここでは３個の窓のために３個のタブをつけましたが、窓の個数も任意です。番号は連番にしておいたほうがよいでしょう。
すべてのタブにマクロ ToggleWindow() を登録しておきます。
タブのプロパティは「セルに合わせて移動やサイズ変更をしない」にしておきます。

タブの Shape名の接頭語 "Tab-" は同じように定数 tabNamePrefix として宣言しています。タブをクリックすると、Shape名はプログラム内では tabName として、その番号部分は index として取得されます。

タブの右側に窓をつくっていきます。必要な列を構成して中に必要な表を作り、できあがったら、その列の範囲を選択して、Shift キーを押しながら該当するタブをクリックします。そうすると、その列構成などが先に用意した一覧表に登録されます。

窓の中に挿入する画像や図形などは、プロパティを「セルに合わせて移動やサイズ変更をする」にしておきます。

出来上がり

Tag-2(取得画像)をクリックした状態

それでは、Shift キーを押さないでそれぞれのタブをクリックしてみましょう。クリックすると該当する窓が開いていれば閉じ、閉じていれば開きます。
開いた窓のタブには色がつき、閉じた窓のタブは白くなっています。

これらの色は、定数 openTabColor、closeTabColor で宣言してあります。色を変えたい場合は、ここをいじりましょう。

左の図は、「基本設定」と「表示設定」を閉じて「取得画像」を開けた状態です。
窓の右側はタブの影響を受けませんので、そこに本体（常時表示されるべき内容）がはいっているはずです。

以下が、プログラムの全体です。本体は途中にある ToggleWindow() で、これだけが Public となっています。

標準モジュール ToggleWindow()

'----- キー押し下げ状態取得のための API 使用宣言
#If Win64 Then
    Declare PtrSafe Function GetAsyncKeyState Lib "User32.dll" (ByVal vKey As Long) As Integer
#Else
    Declare Function GetAsyncKeyState Lib "User32.dll" (ByVal vKey As Long) As Integer
#End If
'----- タブ名の接頭語、ウィンドウ属性一覧表の場所
Private Const tabNamePrefix = "Tab-"
Private Const tableSheetName = "Const"
Private Const tableCellName = "DaftarWindow"
'----- タブの色を指定
Private Const openTabColor = &HC47244
Private Const closeTabColor = &HFFFFFF
'----- タブをクリックした時の実行マクロ
Public Sub ToggleWindow()
Dim index, tabName
      tabName = Application.Caller
      index = Val(Replace(tabName, tabNamePrefix, ""))
      If shiftKeyDown Then resisterWindow tabName, index: Exit Sub
      If Not confirmTabSetting(index) Then Exit Sub
      If isOpen(index) Then
            closeWindow tabName, index
      Else
            openWindow tabName, index
      End If
End Sub
'----- ウィンドウのサイズなどの登録
Private Sub resisterWindow(tabName, index)
Dim openClose, columnStart, columnsCount, columnWidth()
Dim i
      openClose = True
      With Selection
            columnStart = .Cells(1).column
            columnsCount = .Columns.count
            ReDim columnWidth(columnsCount)
            For i = 1 To columnsCount
                  columnWidth(i) = .Columns(i).columnWidth
            Next
      End With
      With ThisWorkbook.Worksheets(tableSheetName).Range(tableCellName)
            .Offset(0, index) = openClose
            .Offset(1, index) = columnStart
            .Offset(2, index) = columnsCount
            For i = 1 To columnsCount
                  .Offset(2 + i, index) = columnWidth(i)
            Next
      End With
      MsgBox tabName & " の登録終了", vbOKOnly, ""
End Sub
'----- ウィンドウの開閉動作
Private Sub openWindow(tabName, index)
Dim columnStart, columnsCount, columnWidth()
Dim i
      If isOpen(index) Then Exit Sub
      With ThisWorkbook.Worksheets(tableSheetName).Range(tableCellName)
            columnStart = .Offset(1, index)
            columnsCount = .Offset(2, index)
            ReDim columnWidth(columnsCount)
            For i = 1 To columnsCount
                  columnWidth(i) = .Offset(2 + i, index)
            Next
      End With
      With ActiveSheet.Columns(columnStart)
            For i = 1 To columnsCount
                  .Offset(0, i - 1).columnWidth = columnWidth(i)
            Next
      End With
      isOpen(index) = True
      changeTabColor tabName, index
End Sub
Private Sub closeWindow(tabName, index)
Dim columnStart, columnsCount
Dim i
      If Not isOpen(index) Then Exit Sub
      With ThisWorkbook.Worksheets(tableSheetName).Range(tableCellName)
            columnStart = .Offset(1, index)
            columnsCount = .Offset(2, index)
      End With
      With ActiveSheet.Columns(columnStart)
            For i = 1 To columnsCount
                  .Offset(0, i - 1).columnWidth = 0
            Next
      End With
      isOpen(index) = False
      changeTabColor tabName, index
End Sub
'----- ウィンドウの開閉状況の取得/設定
Private Property Get isOpen(index)
      isOpen = Range(tableCellName).Offset(0, index)
End Property
Private Property Let isOpen(index, sw)
      Range(tableCellName).Offset(0, index) = sw
End Property
'----- タブの色を変える
Private Sub changeTabColor(tabName, index)
      With ActiveSheet.Shapes(tabName)
            If isOpen(index) Then
                  .Fill.ForeColor.RGB = openTabColor
                  .Fill.Visible = True
                  .Line.Visible = False
                  .TextFrame.Characters.Font.Color = RGB(255, 255, 255)
            Else
                  .Fill.ForeColor.RGB = closeTabColor
                  .Fill.Visible = True
                  .Line.ForeColor.RGB = openTabColor
                  .Line.Visible = True
                  .TextFrame.Characters.Font.Color = openTabColor
            End If
      End With
End Sub
'----- Shift キーが押されているかどうかの判定
Private Function shiftKeyDown() As Boolean
      shiftKeyDown = (GetAsyncKeyState(vbKeyShift) And &H8000)
End Function
'----- 設定がなかった場合の警告表示
Private Function confirmTabSetting(index)
      confirmTabSetting = Not IsEmpty(Range(tableCellName).Offset(0, index))
      If confirmTabSetting Then Exit Function
      MsgBox tabNamePrefix & index & vbCrLf & vbCrLf & _
            "設定するには、必要な列の並びを選択して" & vbCrLf & _
            "SHIFT キーを押しながら" & vbCrLf & _
            "再度該当するタブをクリックしてください。", _
            vbOKOnly, "設定がありません"
End Function