category name » page title date

画像のトグルスイッチ

たとえば、ワークシートにスイッチ画像を貼り付けて、それをクリックするごとに ON/OFF が反転し、そのタイミングで何かの仕事をさせたい、ということがよくあります。
しかも、それらのスイッチは、その時の状況に応じて動的に配置したい、ということがよくあります。

たとえばこんな感じ。だいたい、１個ということはなくて、たいていの場合複数のスイッチが並びますね。それに、たいていグルーピングされています。図のＡ、Ｂ、Ｃのように。
これを混乱しないように実現するには、どうすればよいか。考えてみました。

準備

ICONs ワークシート上に画像を登録しておく

グループごとに使用するスイッチのアイコンは、オリジナルの画像をコピーして貼り付けることにします。オリジナル画像は、どこかのワークシート（ここでは ICONs）の上に置いて、それぞれ Shape 名をつけておきます。
ここでは、６つの画像を用意してそれぞれ
    "VisibleIcon" , "InVisibleIcon"
    "YesIcon" , "NoIcon"
    "SlideOnIcon" , "SlideOffIcon"
という名前をつけました。

実際に使うスイッチは、これらをコピーして名前を変えながら配置することになります。
一種類のスイッチに対して、ON/OFF 用にふたつの画像が必要です。ここに書いたような組み合わせでカップルになっているわけです。

オリジナルを貼り付けたワークシートのオブジェクトをパブリックな変数 IconSheet に代入しておきます。たとえば

Set IconSheet = ThisWorkbook.Worksheets("ICONs")

そのうえで、次のようなクラスを用意します。

クラスの用意

このクラスは、最初に Init で条件を設定しておいて、Show で実際に所定の位置にスイッチを表示します。表示されたスイッチがクリックされるごとに Value を切り替えてやれば、状態に応じたアイコンに切り替わります。
現在の状態は、プロパティ Value を参照すれば取得できます。
Value を切り替える関数は、Init 時に procedureName で指定しておきます。この関数は、Value を切り替えるだけでなく、当然ついでにほかの仕事もできます。
（Init と Show は合体できるでしょうが、とりあえず頭の整理をしやすいように分割しました）

スイッチのアイコンには、右のような switchName がつけられています。その構成は、グループ名 groupName 、グループ内の番号 switchNumber 、値 Value がそれぞれ "-" で結合されたものとなっています。ON/OFF 一組のスイッチの共通項を、coupleName と呼ぶことにします。

クラスモジュール　　　YesNoSｗClass

'----- private member
Private swValue    'その時、ON/OFF どちらのアイコンが見えているかの値
Private swTop, swLeft    'アイコンを表示する位置
Private coupleName    'スイッチの名前
Private swOnName, swOffName    '各アイコンの Shape 名
Private targetSheet    'スイッチを配置するワークシート
Private onIcon, offIcon    'オリジナルのアイコン画像名
Private procName    'スイッチをクリックしたときに実行される関数名
'----- constant
Private Const showMargin = 3    'セル内の余白
'----- public property
Public Property Let Value(sw)    'スイッチの値を設定
      swValue = sw
      changeIconVisibility
End Property
Public Property Get Value()    'スイッチの現在の値を取得
      Value = swValue
End Property
'----- 初期化
Public Sub Init( _
            switchRange, _
            groupName, switchNumber, _
            onIconName, offIconName, _
            procedureName)
                  'スイッチを表示するセル
                  'グループ名、グループ内での番号
                  'それぞれ ON,OFF で表示するアイコンのオリジナル画像名
                  'スイッチがクリックされた時に実行すべきサブルーチン名
      With switchRange
            'セルの左上から showMargin の余白をとって表示される
            swTop = .top + showMargin
            swLeft = .left + showMargin
            Set targetSheet = .Worksheet
      End With
      onIcon = onIconName
      offIcon = offIconName
      procName = procedureName
      coupleName = groupName & "-" & switchNumber
      swOnName = coupleName & "-" & "ON"
      swOffName = coupleName & "-" & "OFF"
End Sub
'----- 表示
Public Function Show()
      On Error Resume Next
      targetSheet.Unprotect
      setIcon onIcon, swOnName, True
      setIcon offIcon, swOffName, False
      Application.CutCopyMode = False
      Value = True
      '↓いちいちこれが無いと、追加された Icon が編集可能になってしまうので
      '   クリックしづらい
      targetSheet.Protect
      Show = coupleName
End Function
'1個のアイコンの表示
Private Sub setIcon(originIconName, coupleName, swValue)
Const waitTime = 50 / 86400000  'Copy の待ち時間
      On Error Resume Next
      'IconSheet から所定の画像をコピー
      '(Shapes.Copy はよくエラーとなるので、念には念をいれて)
      Do
          Do
              IconSheet.Shapes(originIconName).Copy
              DoEvents
              Application.Wait [now()] + waitTime
              DoEvents
          Loop While Err.Number <> 0
      Loop While Application.ClipboardFormats(1) = False
      'targetSheet の所定の位置にペースト
      With targetSheet
          .Cells(1, 1).Select
          .Paste
          With .Shapes(originIconName)
              .top = swTop
              .left = swLeft
              .Name = coupleName
              .Locked = True
              .OnAction = procName
              .Visible = swValue
          End With
      End With
End Sub
'----- swValue に応じてアイコンの表示を切替
Private Sub changeIconVisibility()
      On Error Resume Next
      With targetSheet
            .Shapes(swOnName).Visible = swValue
            .Shapes(swOffName).Visible = Not swValue
      End With
      Err.clear
End Sub
'----- スイッチを表示/隠蔽
Public Property Let Visible(sw)
      On Error Resume Next
      If sw Then
            changeIconVisibility
            Exit Property
      End If
      With targetSheet
            .Shapes(swOnName).Visible = False
            .Shapes(swOffName).Visible = False
      End With
End Property
＜注意＞　Sleep などの API をかませると、とたんに Copy、Paste が
安定して機能しなくなるので、API は使用しないようにした方がよい
と思います。これがわかるまでに、大変苦労しました。

オリジナルのアイコン画像を Book 内に保管するようにしたので、少し煩雑なクラスになってしまいました。画像をファイルから挿入するようにすれば、もっと簡潔になると思いますが、システムが複数のファイル構成になるのがいやで、こうしました。

１個のスイッチを取り付けてみる

標準モジュール　　　　InstallSw()

Public IconSheet
Private mySw
'----- "B14"のセルにスイッチを設置する
Public Sub InstallSw()
      Set IconSheet = ThisWorkbook.Worksheets("ICONs")
      Set mySw = New YesNoSwClass
      With mySw
            .Init ActiveSheet.Range("B14"), _
                  "mySwitch", 1, _
                  "VisibleIcon", "InVisibleIcon", _
                  "MySwClick"
            .Show
      End With
End Sub
'----- スイッチをクリックするごとに実行するマクロ
Public Sub MySwClick()
      With mySw
            .Value = Not .Value ‛これだけで、表示が変わります
         '必要であれば
         '  スイッチが切り替わったら実行する仕事を以下に
         '  たとえば
            If .Value Then ButtonChick
      End With
End Sub

１０個のスイッチを取り付けてみる

YesNoSwClass のインスタンスを複数作成して、並べておくこともできます。その際には、上の MySwClick はほんのちょっと複雑になりますが、クリックされたスイッチの名前を Caller で取得して、必要な切替を行うようにします。
各クラスのインスタンスを Install 時に、coupleName を Key とした連想配列に入れておいて、上の mySw の替わりに使うことになります。

たとえば、こんな感じ。

InstallSw2()

Public SwitchList As Object
'----- "B2" から下に１０個のスイッチを設置する
Public Sub InstallSw2()
Dim n, mysw, coupleName
      Set IconSheet = ThisWorkbook.Worksheets("ICONs")
      Set SwitchList = CreateObject("Scripting.Dictionary")
      For n = 1 To 10
            Set mysw = New YesNoSwClass
            With mysw
                  .Init ActiveSheet.Range("B2").Offset(n - 1, 0), _
                        "mySwitch", n, _
                        "VisibleIcon", "InVisibleIcon", _
                        "mySwClick2"
                        coupleName = .Show
            End With
            Set SwitchList(coupleName) = mysw
      Next
End Sub
'----- スイッチをクリックするごとに実行するマクロ
Private Sub mySwClick2()
Dim mysw, coupleName, s
      s = Split(Application.Caller, "-")
      coupleName = s(0) & "-" & s(1)
      Set mysw = SwitchList(coupleName)
      With mysw
            .value = Not .value
            'スイッチ "mySwitch-n" が切り替わったら実行する仕事をここに
            'たとえば
            If .value Then ButtonChick
      End With
End Sub

ここで、グループ名として s(0) が、その中の番号として s(1) が取得されていますので、必要に応じてそれを判別しながらクリック後の処理を行います。
クリック直後に行う必要がなければ、後で SwitchList(coupleName).value で現在の状態が取得できます。

※注意＞このままでは SwitchList() は保存されませんので、終了時にすべてのスイッチの Shape を削除しておくこと、毎回あらためてスイッチの描画を行うことが必要です。