EXCEL 2010 チェックボックスでプルダウンメニューを塗りつぶす

よろしくお願いします。
タイトルのとおりなのですが、チェックボックスを使って、プルダウンメニューのセルに、塗りつぶしを設定しようとしたのです。

しかし、条件付書式で設定するくらいしかできないようなのです。それでは、目的が達成できないです。

VBAを使おうと考えたのですが、素人なのでよくわかりませんでした。

こういう場合どうすればよいのか、ご存知の方折られましたら、ご教授願います。

VBAを使う場合は、ぜひ、コードを教えてください。

質問者からの補足コメント

• 回答くださりありがとうございました。
  私の質問の書き方が悪かったのですがチェックボックス1個の場合は、この方法で完璧だと思います。
  実は、チェックボックスが複数あり、それぞれのチェックボックスの状況により特定のセルが塗りつぶされるというものです。画像を添付します。
  具体的に書くと、A17にチェックを入れると、B17のOKに塗りつぶしが入り、A19にチェックを入れるとB19のNGに塗りつぶしが入る・・・。という具合のものが50行ほど並んでいます。
  1つ目を設定したのち、2個目以降を、1つ目のマクロを書いたVBEに名前を変えて書き込んだのですが、なぜかうまくいきません。しかも、50個近くあるので書き込むのも大変です。たびたびすいませんが、解決策をご教授願います。よろしくお願いいたします。

  
  No.1の回答に寄せられた補足コメントです。 補足日時：2015/02/25 03:05

• 回答くださりありがとうございます。試してみたのですが、チェックボックスの斜め下に塗りつぶしが入ります。
  それと、遠回しな方法を私がとったのが悪いのですが、（すいませんでした。）実際に、設定が必要な画像を載せます。そうしないと私が文法の意味をよくわかっていないので応用ができないからです。
  画像では、B17をチェックするとC18に塗りつぶしができていますが、本当は、H17を塗りつぶしたいのです。
  さらに、こういうシートが複数あります。これも書いて無くてすいません。
  よろしくご教授お願いします。

  
  No.2の回答に寄せられた補足コメントです。 補足日時：2015/02/25 12:36

• 回答くださりありがとうございます。
  
  試してみたところ
  
  With .Shapes(Application.Caller).DrawingObject
  
  のところでエラーになります。よろしくご教授願います。
  
  よろしくお願いいたします。

  No.3の回答に寄せられた補足コメントです。 補足日時：2015/02/25 16:56

• 回答くださりありがとうございます。
  シート名は変更しています。
  一様エラーの画像を添付いたします。
  ひょっとすると、私の手順がおかしい可能性があるので、マクロの登録手順を箇条書きで構いませんので支持してくださると助かります。
  コードにおかしなところがある場合は、ご教授願います。
  よろしくお願いいたします。

  
  No.4の回答に寄せられた補足コメントです。 補足日時：2015/02/26 00:16

No.3 ベストアンサー 回答者： WindFaller 回答日時： 2015/02/25 13:35

こんにちは。

>画像では、B17をチェックするとC18に塗りつぶしができていますが、本当は、H17を塗りつぶしたいのです。

分かりました。補足の2の画像をみると、

どうやら、CheckBox の大きさとセルの高さから、セルの高さは、標準よりも大きいようですね。この関係が、下に塗りつぶしを生じさせているようです。こちらは、行の高さを13.5にしていましたので、CheckBoxの感知する範囲が、前の行のセルにかかっているので、一つ下にずらしているということなのです。おそらく、全部、ずれているはずです。画像がなければ、迷宮入りになってしまうところでした。

説明しておけばよかっですね。これは、想定外のことでした。

今のところは、
.TopLeftCell.Offset(1, 1)　→.TopLeftCell.Offset(0, 6)
と変えれば済むような気がします。TopLeftCellというのは、四角の左端上のセルが何かという位置を示していますが、CheckBox の枠は、本当は見えていない部分にあるのでした。0は、CheckBox の左上端のセルの位置で、その行なら0、6は、次の列を1として6列先という意味です。

それから、
>こういうシートが複数あります。これも書いて無くてすいません。
やはり、同じ働きなら、ActiveSheet でよいのですが、そうでないなら、シートごと、マクロ名も換えて登録した方がよいかもしれませんね。

Sub CheckBoxesMacro()
　With Worksheets("Sheet1")　'シート限定
　　With .Shapes(Application.Caller).DrawingObject
　　　If .Value = xlOn Then
　　　　.TopLeftCell.Offset(0, 6).Interior.ColorIndex = 46　'←行のズレを直し、H列に出すようにしました。
　　　Else
　　　　.TopLeftCell.Offset(0, 6).Interior.ColorIndex = xlColorIndexNone
　　　End If
　　End With
　End With
End Sub

この回答へのお礼

私のマクロの設定順序がまずかったようです。
きちんとできました。VBAもっと勉強しようと思います。
わかりやすい解説ありがとうございました。

お礼日時：2015/02/26 09:44

No.4 回答者： WindFaller 回答日時： 2015/02/25 21:48

こんばんは。

>試してみたところ
>With .Shapes(Application.Caller).DrawingObject
>のところでエラーになります。

Sub CheckBoxesMacro()
　With Worksheets("Sheet1")　'シート限定
　　With .Shapes(Application.Caller).DrawingObject

Activesheet ではエラーが出なかったのに、そこの部分を変えたらエラーになる原因は、
Sheet1ではなく、本当の「シート名」を、そこに入れてあげないとエラーになります。

例：シート名が「データ」だったら、このようになります。
　With Worksheets("データ")

No.2 回答者： WindFaller 回答日時： 2015/02/25 09:51

こんにちは。

補足内容は、ある程度は想定済みです。そういう内容でないと、質問の意味がありませんよね。

>具体的に書くと、A17にチェックを入れると、B17のOKに塗りつぶしが入り、A19にチェックを入れるとB19のNGに塗りつぶしが入る・

こういう内容ですと、#1のコードの内容は大幅に変わってくるのです。
ひとつだけ、ユーザーさん側で守らなくてはならないことがあります。それは、チェックボックスの位置なのです。
>A17にチェック→B17の塗りつぶし
とありますが、チェックボックスのA17という位置が重要な役割をします。
添付の画像の「雑な」チェックボックスの位置を参照してください。
50個もあるチェックボックスの位置を直すのが面倒でしたら、位置を整えるマクロは作成可能です。

マクロの設定・使い方：
まず、チェックボックス群のあるシートを開いておいてください。
次に、CheckBoxesMacro　を標準モジュールに貼り付けてください。
その次に、同じ場所でよいので、SettingMacroを貼り付けて、マクロを実行してください。
本来は、ActiveSheetは、Worksheets("Sheet1")の方が安全ですが、いろいろな関係から、
ActiveSheetにしました。

以上のマクロは、その全部に一気に、数に限りなく、特定のシート上の全部のチェックボックスにマクロの登録を設定してしまうものですから、そうでないものがある場合は、シート上で直接、チェックボックスから、右クリック－マクロの登録で、外すようにしてください。

'//
Sub SettingMacro()
　Dim cb As Object
　'一回きりの設定用のマクロです。
　If ActiveSheet.CheckBoxes.Count = 0 Then MsgBox "シートが違います。", vbExclamation: Exit Sub
　For Each cb In ActiveSheet.CheckBoxes
　　cb.OnAction = "'" & ThisWorkbook.Name & "'!" & "CheckBoxesMacro" '※
　Next cb
End Sub

'標準モジュールのみ
Sub CheckBoxesMacro()
　With ActiveSheet.Shapes(Application.Caller).DrawingObject
　　If .Value = xlOn Then
　　　.TopLeftCell.Offset(1, 1).Interior.ColorIndex = 46　'←色は#1の色見本からご自由にお選びください。
　　Else
　　　.TopLeftCell.Offset(1, 1).Interior.ColorIndex = xlColorIndexNone
　　End If
　End With
End Sub
'//

※余談です。
ここで、勘の鋭い方ならお気づきかもしれませんが、この「CheckBoxesMacro」のコードは、必ずしも、そのブックになくてはならないものではありません。つまり、xlsmのマクロブックでなくても可能だということです。
SettingMacroの以下の部分を、このように書き換えて
cb.OnAction = "'" & Workbooks("PERSONAL.XLSB").Name & "'!" & "CheckBoxesMacro"

CheckBoxesMacroのマクロを「個人用マクロブック」の標準モジュールに置いておいても可能だということです。
他にも、自家製アドインでも、同様のことは可能です。もしも、何か、必要になった時にでも、この話は思い出せば幸いです。

余談2
これは、ActiveX コントロールでも、同様のことは可能なのですが、複雑なマクロが必要になり、フォームコントロールのように簡単には出来ません。

No.1 回答者： WindFaller 回答日時： 2015/02/24 18:59

こんばんは。

条件付き書式で出来そうな気がしましたが、ダメだったのですか？

以下は、特にプルメニューダウンでということではなく、セルに対して、色塗りするものです。
チェックボックスは、フォームコントロールに設定しました。
フォームコントロールを右クリツクして、[マクロの登録]－[新規]をクリックすると、画面が出てきますから、そこに貼り付けてください。

以下は、A1に登録した場合です。

Sub チェック1_Click()
　If ActiveSheet.CheckBoxes(1).Value = xlOn Then 'カッコの1は、チェックボックスの順序
　Range("A1").Interior.ColorIndex = 46　'色番号(color indexは下記の色見本を参照のこと）
　Else
　Range("A1").Interior.ColorIndex = xlColorIndexNone
　End If
End Sub

色見本
http://www.relief.jp/itnote/xls_colorindex.php