（ＥＸＣＥＬ）チェックボックス,ＴＲＵＥ⇔スピンボタン,ＭＡＸ＋色変化

質問

お世話になります。質問させていただきます。

表題件ですが、先ず説明しやすくするために、
シート１のＡ列複数行にチェックボックス、Ｂ列複数行にMAX100(%)のスピンボタンが縦に並んでいると仮定させていただきます。

例えば、
(1)Ａ４のチェックボックスにチェックを入れるとＢ４のスピンボタンが連動して自動的にMAX値100(%)となり、さらにA4とB4のセルの色が赤くなる。
また
(2)Ｂ４のスピンボタンをMAX値100(%)とすると、連動して自動的にＡ４のチェックボックスにチェックが入り、さらにA4とB4のセルの色が赤くなる。

上記のようにするにはいかがするのでしょうか？

以下にイメージを記載します。

（コンマは、セル区切りを意味します。）
A,B,
checkbox（未check）,70% →色変化なし
checkbox（check入れた）,100%（に自動変化）　→A2B2が赤く　
checkbox（自動的にcheck）,100%（に設定） →A3B3が赤く　

関数やＶＢＡにお詳しい方がおられましたら、何卒アドバイスを頂戴したく存じます。

＊なお、スピンボタンはフォーム、コントロールツールボックス、
どちらが適しているのか、恥ずかしながら、存じませんので、
そちらもアドバイスいただけましたら、大変に光栄に存じます。

よろしくお願い申し上げます。

回答No.7

Wendy02 · ベストアンサー

こんにちは。

Excelの下位バージョンでも調べてみましたが、そのままコードを使用する分にはエラーは出ませんでした。

Dim i As Variant なら、エラーの出ません。
>→i = Replace(tName, "CB", "")

その上で、IsNumeric(i) としてチェックすることも可能です。

大元は、

Replace(tName, "CB", "")

フォームツール名(tName)が、"CB12" とかに返るなら、"CB" を取れば、"12" で、文字列になっていますが、受ける変数(i)で、型の変換が起きて、Dim i As Integer でも、数値になって取り込まれるはずです。特に、CInt で変換する必要はないはずです。
例

　i = CInt(Replace(tName, "CB", ""))

もし、これで問題なく通るようなら、たぶん、バグだと思います。

それ以外では、

i =Replace(tName, "CB", "")

もしも、連続作成の段で、.Name = "CB" & CStr(i) で、元の"CB"が別のものになっていれば、
例えば、　tName は、"CBA12" --> CD削除 -->"A12" となり、これは数字にはなりませんから、「型が一致しない」となります。

--------------------------------------
>一つ難しい箇所がございます。スピンボタンの高さ調整です。
すみません。難しいのではなくて、私のコードが間違っているのです。

高さの部分は、適当に作ったのであまり詳しくみていませんでしたから、まったくヘンな内容でのようです。 y　が縦で、x が横なので、x が出てくるはずがありませんでした。寝起きで書いたせいかもしれません。計算がややこしくなるので、一旦、変数に置いています。

A列に対して、.Offcet(,1) は、B列のこと

　x3 = .Offset(, 1).Left　'左
　y3 = .Offset(, 1).Top　 '上
　x4 = .Offset(, 2).Left　'隣の左
　y4 = .Offset(1, 2).Top　'隣の左下

スピンの位置の高さの調整は、y3 + (y4 - y3) /3

左、上、幅、高
　With .Spinners.Add(x3, y3 + 2, x4 - x3, y4 - y3)

　左　x3
　上　y3　
　　　　　+1 で下に行きます。
　幅　　x4 - x3　(隣の左セルから差をとれば、幅が出る）
　高　　y4 - y3　（上から下の差を取れば高さが出ます）

しかし、私の経験では、実際は、セルの枠線にぴったりとさせないほうがよいようです。

例えば、ぴったりとするなら、こうなりますが、
　With .Spinners.Add(x3, y3, x4 - x3, y4 - y3)

少し調整するなら、
　With .Spinners.Add(x3, y3 + 2, x4 - x3, y4 - y3 -2)

上（トップ） y3 + 2　下に2ポイント
引いた分を
高さ　y4 - y3 -2　下げた分を高さを２ポイント減らす。

で余裕を持たせます。

お礼

誠にありがとうございます。
お蔭様でエラーも消え、スピンボタンの調整もできました。

このたびは極めてご丁寧にご教授くださり、ありがとうございました。
ネットを介してここまで他人様から詳しく教えていただけたのは初めてです。勝手に心の師匠とさせていただきます。

ご多忙にも関わらず（とても優秀なお方だと存じますので、いろいろとお忙しいかとお察します。）初学者の私の質問に対して呆れずにきちんと対応していただき、"ただただ感謝"以外の感情が出てまいりません。

また、コードを教えてもらって貼り付けて終了しただけでは、自分自身、何も成長になりません上、教えていただいたWendy02様にも失礼になると思いますので、少しずつではありますが、コードをこつこつと解釈し自分のものにできるように心がけ、延いては自分自身でも創造できるように努力したいと思います。

ちなみに、現在、初心者にも関わらず、不遜にもＥＸＣＥＬで自分好みの「スケジューラー＆簡易データベース＆日記＆家計簿＆プロジェクト及びタスク管理」を1つのブックに作成中です。
（ネットで調べても"自分"の理想はなかったため。）

お蔭様で、最も肝で難関な箇所の一つであろう、プロジェクト及びタスク表の動的管理がだいぶ理想どおりになりました。

今後もおそらく関数やＶＢＡに関する質問をこちらのサイトで投稿させていただくと思います。
たいへん図々しく虫のいい話しではありますが、その際、もしお手すきでしたら、またお付き合い願えましたら、幸甚です。

繰り返しになりますが、このたびは本当にありがとうございました。

回答No.6

Wendy02

こんばんは。

ところで、Excelのバージョンはいくつですか？
型の宣言自体で、型の違いは出てくるはずはないのですが、どこで発生しているか、分かりません。ですから、エラーが出ている原因は見えてこないのです。

そこで、ステップモードで、調べてみてください。

●Sub CBMacro()　　'●はブレークポイント（右端のマージンにクリックすると●が出る

次に、チェックボックスをクリックすると、そこで止まります。次に、F8 を押して、一つずつ、様子を調べ反応をみます。ローカルウィンドウを出していたら、そこで、変数などの戻り値をみます。

お礼

たびたび本当にありがとうございます。
Excelのバージョンは2002です。

さて、アドバイス通りにステップモードを試してみました。

「デバッグ」→「ブレークポイントの設定/解除」→"Sub CBMacro()"行をブレークポイントに設定し茶色に→チェックボックスをクリック→"Sub CBMacro()"行が黄色く反転→F8を押してみたこころ、

→i = Replace(tName, "CB", "")

上記の行で「型が一致しません」とのエラーポップアップが表示され、左端マージンに黄色い矢印が表示されました。

"Sub SPMacro()"行も同様でした。

お手数をおかけいたします。よろしくお願い申し上げます。

補足

ほんとにすみません。
よろしければ、追加質問させてください。

いろいろと自分好みに修正できるようになったのですが、
一つ難しい箇所がございます。スピンボタンの高さ調整です。

-------------------------------------------------------------------
'left,top,width,height
'スピンの位置の高さの調整は、y3 + (x4 - x3) / 10　<-- 12
With .Spinners.Add(x3, y3 + (x4 - x3) / 12, x4 - x3, (y4 - y3) / 2)
-------------------------------------------------------------------

幼稚な私の知識では上記コードをどうしても解読できませんでした。
left=.Offset(0, 1).Left,

top=.Offset(0, 1).Top+(.Offset(0, 1).Offset(0, 1).Left-.Offset(0,1).Left)/12,

width=.Offset(0, 1).Offset(0, 1).Left-.Offset(0, 1).Left,

height=(.Offset(0, 1).Offset(1,0).Top-.Offset(0, 1).Top)/2

上記のようのことなのかもしれないと勝手に解釈したのですが、どうしてもそれ以上が解読できませんでした。

よろしければヒントをご教授願えましたら、幸甚です。

回答No.5

Wendy02

こんばんは。

時間帯が、早朝で、ちょっとヘンなところがありますね。

Sub AddFormButton()

×　.Range("A1:A10").EntireRow.RowHeight = 20　'セルの高さ
　　↓
.Range("A1:A100").EntireRow.RowHeight = 20　'セルの高さ

ただし、スピンボタンの縦・横・幅・高さを調整してください。あまりきれいに入っていないようです。
--------------------------------------

本題の「型が一致しません」は、

Sub CBMacro()
　　Dim tName As String
　　Dim i As Variant　　'←Integer から Variant に換え
　　tName = Application.Caller
　　MsgBox tName　'これを加えて確認してください。
　　i = Replace(tName, "CB", "")
　　MsgBox i　' これも加えて確認してください。

　　おそらく、完全な数字になっていないか、元の名前も正しく入れられてない可能性があります。一旦、「 FormToolsDel」の削除マクロで消してから、もう一度試してみてください。

お礼

お世話になります。

Dim i As Variantに書き直しました。
相変わらず、「型が一致しません」と表示されるのですが、きちんと機能しています。
（機能とは要するに「チェックするとスピンが１００になり、該当セルが赤色に」また「スピンボタンを１００にするとチェックオンになり、該当セルが赤色に」なるということです。）

私としましては、以上で、ジュウニブンに満足しており、こちらを締め切って、すぐにでもお礼ポイントを差し上げたいのですが、
私の結果報告がWendy02様にとって十全なものではないかもしれないとの懸念がございますので、念のため、もう少しだけ締切を延長しておきます。明日には締め切らせていただきます。

重ね重ねも、本当にありがとうございました!!心より感謝です!!

回答No.4

Wendy02

こんばんは。

>上記をＡ１Ｂ１に限定せずに、Ａ１～Ａ１００（checkBox1～100）、Ｂ１～Ｂ１００>（SpinButton1～100）へと同様の処理を効率的に複製する方法はご存知でしょうか？

以下は、新しいシートに何も入れないで、そのまま試してみてください。
セルの高さや幅など、微調整を行ってください。FormToolsDelを実行すれば、全てはきれいに消え、セル幅、セルの高さも標準に戻ります。

旧スタイルのマクロで、フォーム・ツールのほうが簡単です。コントロールツールのほうは、クラス・インスタンスが必要になってしまいます。もし、ご希望がコントロールツールなら、おっしゃってください。コードは複雑になりますが、可能です。

'-----------------------------------------
'標準モジュール

Sub AddFormButton()
Dim c As Range
Dim x1 As Double
Dim y1 As Double
Dim x2 As Double
Dim y2 As Double
Dim x3 As Double
Dim y3 As Double
Dim x4 As Double
Dim y4 As Double
Dim i As Integer
i = 1
With ActiveSheet
.Range("A1:A10").EntireRow.RowHeight = 20　'セルの高さ
.Range("A1:B1").EntireColumn.ColumnWidth = 12.5　'セルの幅
For Each c In .Range("A1:A100")
With c
　x1 = .Left
　y1 = .Top
　x2 = .Offset(, 1).Left
　y2 = .Offset(1).Top
　x3 = .Offset(, 1).Left
　y3 = .Offset(, 1).Top
　x4 = .Offset(, 1).Offset(, 1).Left
　y4 = .Offset(, 1).Offset(1).Top
End With
'left,top,width,height
　With .CheckBoxes.Add(x1, y1, x2 - x1, y2 - y1)
　　.Caption = CStr(i)　'キャプション表示
　　.Name = "CB" & CStr(i)
　　.OnAction = "CBMacro"
　End With
　'left,top,width,height
　'スピンの位置の高さの調整は、y3 + (x4 - x3) / 10　<-- 12
　With .Spinners.Add(x3, y3 + (x4 - x3) / 12, x4 - x3, (y4 - y3) / 2)
　　.Name = "SP" & CStr(i)
　　.OnAction = "SPMacro"
　　.Max = 100
　　.Min = 0
　　.SmallChange = 20 'スクロール量
　　.LinkedCell = c.Offset(, 2).Address　'値の出力
　End With
　i = i + 1
Next c
End With
End Sub

Sub CBMacro()
　　Dim tName As String
　　Dim i As Integer
　　tName = Application.Caller
　　i = Replace(tName, "CB", "")
　　With ActiveSheet
　　　　If .CheckBoxes(tName).Value = xlOn Then
　　　　　 .CheckBoxes(tName).TopLeftCell.Resize(, 2).Interior.ColorIndex = 3
　　　　　 .Spinners("SP" & i).Value = 100
　　　　ElseIf .CheckBoxes(tName).Value = xlOff Then
　　　　　　.CheckBoxes(tName).TopLeftCell.Resize(, 2).Interior.ColorIndex = xlNone
　　　　　　.Spinners("SP" & i).Value = 0
　　　　End If
　　End With
End Sub
Sub SPMacro()
　Dim tName As String
　　Dim i As Integer
　　tName = Application.Caller
　　i = Replace(tName, "SP", "")
　　With ActiveSheet
　　　　If .Spinners(tName).Value = 100 Then
　　　　　 .Spinners(tName).TopLeftCell.Offset(, -1).Resize(, 2).Interior.ColorIndex = 3
　　　　　 .CheckBoxes("CB" & i).Value = xlOn
　　　　ElseIf .Spinners(tName).Value < 100 Then
　　　　　　.Spinners(tName).TopLeftCell.Offset(, -1).Resize(, 2).Interior.ColorIndex = xlNone
　　　　　　.CheckBoxes("CB" & i).Value = xlOff
　　　　End If
　　End With
End Sub

'-------------------------------------------
'おまけ
Sub FormToolsDel()
'フォームなど削除用マクロ
With ActiveSheet
　 .Range("A1:A100").EntireRow.RowHeight = .StandardHeight
　 .Range("A1:B1").EntireColumn.ColumnWidth = .StandardWidth
　 .CheckBoxes.Delete
　 .Spinners.Delete
　 .Range("A1:C100").Clear
End With
End Sub

お礼

たびたびのご回答誠に感謝申し上げます。
ひじょうに親身にご教授くださり、心底痛み入ります。
ありがとうございます。

さっそく、上記「AddFormButton()」「CBMacro()」「SPMacro()」を
新規に作成したワークシートのＶＢＥに貼り付けました。

そして、マクロ「AddFormButton()」は無事に実行できたのですが、（Ａ列に100個のチェックボックスとＢ列に100個のスピンボタンが作成されました。）
その後、マクロ「CBMacro()」及びにマクロ「SPMacro()」を実行しようとすると、「型が一致しません」とうエラーになってしまいました。

何から何まですぐに質問するのは心苦しいので、自分でいろいろと調べてみてDim tName As StringやDim i As Integerあたりを弄ってみたのですが、どうも解決しませんでした。

お恥ずかしい限りですが、原因がお解かりでしたら、ご教授願えましたら、幸甚の極みです。

回答No.3

Wendy02

こんにちは。

>反応がまったくございません。

簡単なことですが、

本来は、コントロールツールが先で、コードが後なのですが、この場合は、コントロールとコードが連結していないのだと思います。

一旦、VBEditor 上で、

Editor ペインの上の方に、横長の二つの窓がありますから、

以下のように、右左に分かれていることを確認してください。
分かれていなかったら、一度、その窓のところの下向きの▽のダウンボタンを開いて、同じコントロール名を探してみてください。もし、違うようでしたら、それにあわせたコントロール名にしてください。

CheckBox1　　　　　　|　　　　　Click

SpinButton1　　　　　|　　　　　Change

または、編集モード（青い三角定規）がオンになっていることを確かめて、コントロールツールのチェックボックスなどをダブルクリックすると、自動的に、マクロのほうに飛ぶはずです。

お礼

すみません。たいへん素晴らしいコードをご教授いただけたことをようやく理解できました!!
(チェックボックス、スピンボタンともにフォームのものを使用していました。)

コントロールツールのものを使用しましたところ、反応がありました。
ただし、質問欄での私の説明が稚拙なために、誤解を生んでしまいました。そこで、自分でコードを以下のように修正させていただきました。

Private Sub CheckBox1_Click()
'チェックボックス
If CheckBox1.Value Then
SpinButton1.Value = 100
End If
End Sub

Private Sub SpinButton1_Change()
'スピンボタン
Range("B1").Value = SpinButton1.Value
If SpinButton1.Value = 100 Then
CheckBox1.Value = True
Range("A1:B1").Interior.ColorIndex = 3
Else
CheckBox1.Value = False
Range("A1:B1").Interior.ColorIndex = xlNone
End If
End Sub

要するに
「Ａ１に配置したチェックボックスをオンにする」or「Ｂ１に配置したスピンをＭＡＸ値１００にする」
いづれかの状態になれば、そのチェックボックスとスピンボタンが連動し、また、それらを配置している該当セル（上記ではＡ１とＢ１）の色を赤くしたいと考えておりました。

お蔭様で、無事にできましたが、恥ずかしながら、未だに未解決なことがございます。
上記をＡ１Ｂ１に限定せずに、Ａ１～Ａ１００（checkBox1～100）、Ｂ１～Ｂ１００（SpinButton1～100）へと同様の処理を効率的に複製する方法はご存知でしょうか？

上記コードをこつこつ100個×2と作成するのは、あまり非効率のような気がしまして・・・・。注文が多くて申し訳ございません。
もしよろしければ、ご教授願います。

このたびは誠に感謝しております。

回答No.2

Wendy02

こんばんは。

わたし的にまとめますと、

>checkbox（未check）,70% →色変化なし
>checkbox（check入れた）,100%（に自動変化）　→A2B2が赤く　
>checkbox（自動的にcheck）,100%（に設定） →A3B3が赤く　

CheckBox（Off）,SpinButton 値　99まで →色変化なし
CheckBox（On）,SpinButton 値　100　→A2B2でセル　赤　
SpinButton 100 --> CheckBox（On） →A4B4でセル　赤 （A2B2は変化なし）

ということでしょうか？

>スピンボタンはフォーム、コントロールツールボックス、どちらが適しているのか、恥ずかしながら、存じません

Excel2000 以上では、なるべくコントロールツールを使います。フォームツールは、Ver 95(Ver5)のものです。元々、DialogSheet に込みこんで使うものです。古くから使っていた人は別として、今は、マニュアルも手に入らないはずです。

とはいえ、コントロールツール自身も、個々のプロパティの説明は、なぜか、ヘルプでは、検索があまりヒットしないようです。理由は良く分かりません。ヘルプには書かれているのに、検索の項目には登録していないようです。もう少し、一般に使えるような検索項目があってよいのではないかと思います。

それに、Excelにしても、Wordにしても、インストラクティブなマニュアルが存在しないし、ヘルプ自体も英和訳のせいなのか、文章的に読みにくく、まとまりがありません。ただし、これは、ネイティブの英語の世界でも同じようです。

'----------------------------------
'シートモジュール

Private Sub CheckBox1_Click()
'チェックボックス
　　If CheckBox1.Value Then
　　　　If SpinButton1.Value < 100 Then
　　　　　　Range("A2:B2").Interior.ColorIndex = 3
　　　　End If
　　Else
　　　　Range("A2:B2").Interior.ColorIndex = xlNone
　　End If
End Sub

Private Sub SpinButton1_Change()
'スピンボタン
　　Range("D1").Value = SpinButton1.Value
　　If SpinButton1.Value = 100 Then
　　　　CheckBox1.Value = True
　　　　Range("A4:B4").Interior.ColorIndex = 3
　　Else
　　　　CheckBox1.Value = False
　　　　Range("A4:B4").Interior.ColorIndex = xlNone
　　End If
End Sub

お礼

丁寧なご回答まことにありがとうございます。
何らかの私のミスだと思いますが、
ためしに、シート１のＡ１にチェックボックス、Ｂ１にスピンボタン（リンクするセルＤ１）を設定し、ＶＢのエディターのシート１にご教授いただいたコードを貼り付けてみたのですが、反応がまったくございません。

ご教授いただいたコードを参考にもう少し、試行錯誤してみます。

誠にありがとうございました。

補足

すみません。たいへん素晴らしいコードをご教授いただけたことをようやく理解できました!!
(チェックボックス、スピンボタンともにフォームのものを使用していました。)

コントロールツールのものを使用しましたところ、反応がありました。
ただし、質問欄での私の説明が稚拙なために、誤解を生んでしまいました。そこで、自分でコードを以下のように修正させていただきました。

Private Sub CheckBox1_Click()
'チェックボックス
If CheckBox1.Value Then
SpinButton1.Value = 100
End If
End Sub

Private Sub SpinButton1_Change()
'スピンボタン
Range("B1").Value = SpinButton1.Value
If SpinButton1.Value = 100 Then
CheckBox1.Value = True
Range("A1:B1").Interior.ColorIndex = 3
Else
CheckBox1.Value = False
Range("A1:B1").Interior.ColorIndex = xlNone
End If
End Sub

要するに
「Ａ１に配置したチェックボックスをオンにする」or「Ｂ１に配置したスピンをＭＡＸ値１００にする」
いづれかの状態になれば、そのチェックボックスとスピンボタンが連動し、また、それらを配置している該当セル（上記ではＡ１とＢ１）の色を赤くしたいと考えておりました。

お蔭様で、無事にできましたが、恥ずかしながら、未だに未解決なことがございます。
上記をＡ１Ｂ１に限定せずに、Ａ１～Ａ１００（checkBox1～100）、Ｂ１～Ｂ１００（SpinButton1～100）へと同様の処理を効率的に複製する方法はご存知でしょうか？

上記コードをこつこつ100個×2と作成するのは、あまり非効率のような気がしまして・・・・。注文が多くて申し訳ございません。
もしよろしければ、ご教授願います。

このたびは誠に感謝しております。

回答No.1

xls88

試しに作ってみました。
取りあえず、フォームの方で、(1)の場合です。
チェックボックスを右クリックしてメニューから「マクロの登録」をしてください。
チェックボックスをクリックすると、登録したマクロが実行されます。

Sub test1()
　　Dim cbrng As Range
　　Dim ac As String
　　Dim n As Variant

　　ac = Application.Caller
　　Set cbrng = ActiveSheet.Shapes(ac).TopLeftCell
　　Select Case ActiveSheet.CheckBoxes(ac).Value
　　　　Case 1: n = 3
　　　　Case 0: n = 0
　　End Select
　　Range(cbrng, cbrng.Offset(, 1)).Interior.ColorIndex = n
　　With ActiveSheet.Spinners("スピン 1")
　　　　.Max = 100
　　　　.Value = 100
　　End With
　　Set cbrng = Nothing
End Sub

お礼

丁寧なご回答まことにありがとうございます。
私のミスだと思うのですが、試してみたところ、
チェックボックスをクリックするときちんとセルが赤くなるのですが、
同時にポップアップで「×４００」と表示されてしまいました。

回答くださったコードを自分なりに解釈して、原因を究明してみます。
ありがとうございました。