Excel changeイベントをループさせる方法

質問

ご質問させていただきます。

Excel2007を使用しています。
チェックボックスを１９０個作り以下のプロシージャを作成しました。
１９０個のチェックボックスは開発タブの挿入をクリックしてActive Xコントロールのチェックボックスを選択してデザインモードでコピーして作りました。
やりたいことは、チェックボックスのON/OFFの瞬間に以下のプロシージャの処理を実行したいのです。
changeイベントを使うみたいなのですが、チェックボックスが１９０個もあるのでループさせた方が良いと思うのですが、そもそもchangeイベントをループさせることはできるのでしょうか？
ご存知の方がいらっしゃいましたら教えてください。
よろしくお願いいたします。
なお、私のVBAの知識は初心者レベルで、下記のプロシージャもこちらのサイトで教えていただいたものを自分で少し変更しただけです。

Sub チェックボックスのループ()

Dim i As Integer
For i = 0 To 189

sCtrlName = "CheckBox" & CStr(1 + i)

If Me.OLEObjects(sCtrlName).Object.Value = True Then

Cells(1 + i, 2).Value = Cells(1 + i, 2).Value

Else

Cells(1 + i, 2).Formula = "=Sheet2!A" & 1 + i & ""

End If

Next i

End Sub

回答No.2

keithin · ベストアンサー

条件付き書式で赤や青（あるいは白）に塗られているセルでは，このマクロで，あるいは手動ででも，セルの色塗りをしても条件付き書式の発色の方が優先（上書き表示）してしまい色が現れません。

手口は色々考えられますが，一つの方法としては追加ご相談のマクロを

Sub macro1()
　Dim myCheck As Shape
　Set myCheck = ActiveSheet.Shapes(Application.Caller)

　myCheck.TopLeftCell.Value = Not myCheck.TopLeftCell.Value

　With myCheck.TopLeftCell.Offset(0, 1)
　　If myCheck.ControlFormat.Value = 1 Then
　　　.Value = .Value
　　Else
　　　.FormulaR1C1 = "=Sheet1!R[1]C[8]"
　　End If
　End With
End Sub

のような具合に変更してみると，チェックボックスを配置したセル（必要に応じて別列のセル）にチェックの状態に応じて-1か0の数字が現れます。
条件付き書式の方で，該当のセルが-1ならば白にするを最優先で発色させるように組み込んでみて下さい。

＃チェックボックスを配置したセルでは，必要に応じて
・セルの色を白に，文字の色を白にしておく
・セルの書式設定の表示形式のユーザー定義で ;;;　と設定しておく
などで，-1や0の表示を隠しておいてください。

＃参考
別の手として，今のマクロでmycheck.controlformat.valueの値に応じて対応するセルを「値」と「数式」とに書き換えているのに併せて，該当セルの条件付き書式も直接書き換えてしまうような方法も考えられます。
が，こちらの手を使うと各行ごとに条件付き書式が「まだらに」施された状態となってしまい，シートの安全性が損なわれる恐れがあります。

＃余談
新しい課題や問題点が発生した際には，原則として新しいご相談として投稿し直すようになさって下さい。
今回の追加ご質問についても，まだ問題が継続したり「もうちょっとこうしたい」があるようでしたら，やはり新たなご相談として投稿なさってください。

お礼

keithin 様

ご回答ありがとうございました。
教えていただいた方法でできました。
実際に運用してみて再び直したい部分がでてきたのですが、上手く直せなかったので新しい質問を後で投稿させていただきますので、よろしくお願いいたします。
この度は本当にありがとうございました。

回答No.1

keithin

アプローチは色々考えられますが，そういうお話だった場合は，今度はActiveXコントロールではなくフォームコントロールのチェックを使った方が便利と思います。

手順：
ALT+F11でVBE画面を開き，挿入メニューから標準モジュールを挿入し，下記をコピー貼り付ける

sub macro1()
　dim myCheck as shape
　set mycheck = activesheet.shapes(application.caller)

　with mycheck.topLeftcell.offset(0, -1)
　　If mycheck.controlformat.value = 1 then
　　　.value = .value
　　else
　　　.formular1c1 = "=Sheet2!RC[-1]"
　　end if
　end with
end sub

シートに戻る
今のチェックボックスはすべて削除する
改めて「C1セルに」C1セルの大きさの中に収まるように，フォームコントロールのチェックボックスを１つ配置する
チェックボックスを右クリックして「マクロの登録」を開始し，上記のmacro1を選んでOKする

「C1セルを」選び，下向けにえいやっと190個オートフィルドラッグして，C190セルまでコピーする。
フォームを選んでコピーするのではなく，フォームを載せたセルごとコピーするので間違えないこと。

＃わざわざマクロを190通り用意することも，またご質問で書かれているように毎回全部のチェックボックスを巡回して調査反映するといった手間も要りません。

お礼

keithin 様

ご回答ありがとうございます。
できました！凄いです！
実際に運用してみて少し変更したいところがでてきたので、自分で変更を加えてみたのですが上手くいきませんでした。
もしよろしければ教えていただけないでしょうか？

チェックボックスのONで値を記録させるセルには条件付書式が設定してあり、セルの値によって背景色が青・赤・白になるようにしてあります（この条件付き書式にはVBAを使用しておりません）。
変更しようとしたことは、チェックボックスのONで従来の仕様通りセルの値を記録させて、かつ、新たにセルの背景色を白にすることです。
そこで、教えていただいたプロシージャに.Interior.Color = RGB(255, 255, 255)を追加したのですが、無反応でした。
現在のプロシージャは下記の通りになります。
なお、もし質問を新しくした方がよろしければおっしゃってください。
よろしくお願いいたします。
Sub macro1()
Dim myCheck As Shape
Set myCheck = ActiveSheet.Shapes(Application.Caller)

With myCheck.TopLeftCell.Offset(0, 1)
If myCheck.ControlFormat.Value = 1 Then
.Value = .Value
.Interior.Color = RGB(255, 255, 255)
Else
.FormulaR1C1 = "=Sheet1!R[1]C[8]"
End If
End With
End Sub