『セルの中にオプションボタンを収める方法』（MAKO） いつもお世話になっています。 オプションボタンを使った表(２者選択×３０行)を作っているのですが、 セルが小さいために、フォームのオプションボタンを使うと、ボタンの○は ちょうどセルに入るのですが、貼付け枠？を最小に設定しても隣のセルにはみ出てしまい、 隣のセルへの入力に不便します。また、グループの枠の線も消せないので、 コントロールツールボックスの利用になるかと思うのですが、 コントロールツールボックスのオプションボタンの貼付け枠？に背景と同じ色づけを することはできるのでしょうか？ 本当はボタンの数が多いので、ボタンの大きさやセル内の位置など調整する事が難しく、 以前に教えていただいた、VBAを使ったチェックボックスの連動もチャレンジしてみたのですが、 私の能力でいろいろ試してみても、Aのチェックボックスの操作でBのチェックボックスを 反転チェックしたり消したりまでは出来たのですが、Bのチェックボックスから操作できません。 どなたかお助けください。 ---- 「2者選択」ってのは、「AかBか？」って事ですよね？ もしかして、↓の関連の [[20080614120403]]『チェックボックスを使って行の挿入』（MAKO） ＞リストはカテゴリーA、カテゴリーB、またはいずれでもない（挿入なし）で重複はしません。 のご説明では私も半平太さん同様 ＞人が目で見て重複させない（重複していたら、手で解消する）と云う意味に理解 したのですが、やはりここの問題なのですかね・・・。 列も2列しか無い様ですし BeforeDoubleClickで、ターゲットセルに"■"を入れ込む時に 相手のセルを""にするのでも良さそうに思いますが。 '------ Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Dim flag As Object Const adr As String = "aa2:ab5" Set flag = Application.Intersect(Target, Range(adr)) If flag Is Nothing Then Exit Sub Cancel = True With Target If .Value = "■" Then .Value = "" Else .Value = "■" If .Column = 27 Then .Offset(, 1).Value = "" Else .Offset(, -1).Value = "" End If End If End With End Sub (HANA) ---- HANAさん、ご回答ありがとうございます。 HANAさんの丁寧なコメントも、質問ボードでいつも参考にさせていただいています。 今回の質問は、 [[20080703172405]]『任意の行を常に同じ行番号に固定…』（MAKO）に関連するものではなく、 (ここで作成した書式は問題なく、おおいに活用させていただいてます！） 実は、[[20080609212903]]『VBAを使ったセルのチェックボックスの連動』（MAKO）で教えていただいた コードを使って作った書式をつかって、更に改良を望んだものです。 今回、HANAさんから教えていただいたコードを、以下のように当てはめてみました。 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Dim flag As Object Const adr As String = "AA5:AB35,AE5:AE35,AF5:AF35,AL5:AL35,AR5:AR35,AX5:AX35" Set flag = Application.Intersect(Target, Range(adr)) If flag Is Nothing Then Exit Sub Cancel = True With Target If Not Intersect(Target, Range("AE5:AE35")) Is Nothing Then Target.Range("A1,B1,H1,N1,T1").Value = IIf(Target.Value = "●", "", "●") Else Target.Value = IIf(Target.Value = "●", "", "●") If .Column = 27 Then .Offset(, 1).Value = "" Else .Offset(, -1).Value = "" End If End If End With End Sub ちょっと意図がわかりにくいと思うので念のため説明しますが、以下のような表で、 AA AB ･ ･ ･ AE ･ AF ･ AL ･ AR ･ AX ･･･ ･ ･ 5 ■ □ □ ■ □ □ ■ 6 ■ □ ■ ■ ■ ■ ■ 7 □ ■ □ □ ■ □ □ 8 □ ■ ■ ■ ■ ■ ■ 9 ■ □ □ □ □ ■ □ ･ ･ AA,AB列に関しては必ずどちらかを選択（オプションボタン） AF-AX列は複数選択可で、全部選択する場合にはAEにチェック ということです。それぞれのチェックに応じてイベントがあるのですが、 AA,AB列は必須選択でオプションボタン式にしたかったのです。 上記、教えていただいたコードを当てはめたもので、基本的に意図してることはかなっているのですけど、 当然、■の入っているセルを再度ダブルクリックすると、「AA,ABどちらも空白」というケースがあります。 もし可能ならば、例えば上記の表にて、「AA5をダブルクリックして■を消したときに、AB5に■が入る」 逆も同じく「AB5の■を消せば、AA5に■入る」事は可能でしょうか？ 仮にその様式が可能な場合でも、やはりDeleteで消してしまった場合はどちらも空白になってしまうのでしょうか？ もしくは、「■の入ったところをダブルクリックしても、■は消えない」（できればDeleteでも）という、 本来のオプションボタンの機能と同じでももちろんよいのですけど。 自分でもいろいろ試してみるのですがどうも思うように動かず、よろしければ教えてください。 (MAKO) ---- ＞もし可能ならば、例えば上記の表にて、「AA5をダブルクリックして■を消したときに、AB5に■が入る」 ＞逆も同じく「AB5の■を消せば、AA5に■入る」事は可能でしょうか？ ■を消したときに、相手に■を入れれば良いのではないでしょうか？ ＞仮にその様式が可能な場合でも、やはりDeleteで消してしまった場合はどちらも空白になってしまうのでしょうか？ なりますね。 ですから、マクロ以外からは値を変更出来ないように しておくのはどうでしょう。 '---AA列かAB列に「■」をつける Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Application.Intersect(Target, Range("AA5:AB35")) Is Nothing Then Exit Sub Application.EnableEvents = False Cancel = True With Target If .Value = "■" Then '■だったら .Value = "" '""にして If .Column = 27 Then '↓相手側を■に .Offset(, 1).Value = "■" Else .Offset(, -1).Value = "■" End If Else 'それ以外だったら .Value = "■" '■にして If .Column = 27 Then '↓相手側を""に .Offset(, 1).Value = "" Else .Offset(, -1).Value = "" End If End If End With Application.EnableEvents = True End Sub '---AA5:AB35の範囲はワークシートに直接の値変更不可 Private Sub Worksheet_Change(ByVal Target As Range) If Application.Intersect(Target, Range("AA5:AB35")) Is Nothing Then Exit Sub Application.EnableEvents = False Application.Undo Application.EnableEvents = True MsgBox "ダブルクリックで変更してください。" End Sub (HANA) ---- HANAさん、ありがとうございます。 テストしてみましたら、希望通りの動きでした。流石です！！ 出来の悪い生徒で申し訳ありません。AE列からAX列を動かすもともとのコードといろいろ 組み合わせてみたのですが、基本が出来ておらず力不足でどうしてもエラーが出てしまいます。 以下、試してみた例の一つ （単純に足しただけなのですが、AA列とAB列が動かなくなってしまいます） Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Dim flag As Object Const adr As String = "AE5:AE35,AF5:AF35,AL5:AL35,AR5:AR35,AX5:AX35" Set flag = Application.Intersect(Target, Range(adr)) If flag Is Nothing Then Exit Sub Cancel = True With Target If Not Intersect(Target, Range("AE5:AE35")) Is Nothing Then Target.Range("A1,B1,H1,N1,T1").Value = IIf(Target.Value = "■", "", "■")　'←前回コメント●になってました。ややこしくてすいません。 Else Target.Value = IIf(Target.Value = "■", "", "■") 　 End If End With If Application.Intersect(Target, Range("AA5:AB35")) Is Nothing Then Exit Sub Application.EnableEvents = False Cancel = True With Target If .Value = "■" Then '■だったら .Value = "" '""にして If .Column = 27 Then '↓相手側を■に .Offset(, 1).Value = "■" Else .Offset(, -1).Value = "■" End If Else 'それ以外だったら .Value = "■" '■にして If .Column = 27 Then '↓相手側を""に .Offset(, 1).Value = "" Else .Offset(, -1).Value = "" End If End If End With Application.EnableEvents = True End Sub '---AA5:AB35の範囲はワークシートに直接の値変更不可 Private Sub Worksheet_Change(ByVal Target As Range) If Application.Intersect(Target, Range("AA5:AB35")) Is Nothing Then Exit Sub Application.EnableEvents = False Application.Undo Application.EnableEvents = True MsgBox "ダブルクリックで変更してください。" End Sub どのようにしたら、組み合わせが出来ますでしょうか？お手数かけてすいません。 (MAKO) ---- えっと・・・たぶんコードの作りが悪いのですね。 （MAKOさんの出来が悪い　と言うわけではなく。） ExitSub してしまうのが簡単なので・・・。 例えば ＞AA5:AB35 の範囲が変更されたとしますよね。 ＞Const adr As String = "AE5:AE35,AF5:AF35,AL5:AL35,AR5:AR35,AX5:AX35" ＞Set flag = Application.Intersect(Target, Range(adr)) ＞If flag Is Nothing Then Exit Sub adrの中に「AA5:AB35」は含まれないので flag は Nothing です。 よって　→　Exit Sub 私が載せた部分を先に持ってきても同じです。 ＞"AE5:AE35,AF5:AF35,AL5:AL35,AR5:AR35,AX5:AX35" が変更された場合は ＞AA5:AB35 の範囲に含まれないので ＞Is Nothing Then Exit Sub します。 なので、範囲内の時に処理をする　形に変更するのはどうでしょう。 ↓な感じで。 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Not Application.Intersect(Target, Range("A1:A10")) Is Nothing Then Cancel = True MsgBox "A1:A10 の範囲内です。" End If If Not Application.Intersect(Target, Range("C1:C10")) Is Nothing Then Cancel = True MsgBox "C1:C10 の範囲内です。" End If End Sub (HANA) ---- HANAさん、ありがとうございます。 未熟なもので、せっかくの意図を汲み取れず、はずしていたら申し訳ありません。 以下のように理解して、コードを貼り付けてみました。 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Not Application.Intersect(Target, Range("AA5:AB35")) Is Nothing Then Cancel = True With Target If .Value = "■" Then '■だったら .Value = "" '""にして If .Column = 27 Then '↓相手側を■に .Offset(, 1).Value = "■" Else .Offset(, -1).Value = "■" End If Else 'それ以外だったら .Value = "■" '■にして If .Column = 27 Then '↓相手側を""に .Offset(, 1).Value = "" Else .Offset(, -1).Value = "" End If End If End With Application.EnableEvents = True End If If Not Application.Intersect(Target, Range("AE5:AX35")) Is Nothing Then Cancel = True With Target If Not Intersect(Target, Range("AE5:AE35")) Is Nothing Then Target.Range("A1,B1,H1,N1,T1").Value = IIf(Target.Value = "■", "", "■") Else Target.Value = IIf(Target.Value = "■", "", "■") End If End With End If End Sub '---AA5:AB35の範囲はワークシートに直接の値変更不可 Private Sub Worksheet_Change(ByVal Target As Range) If Application.Intersect(Target, Range("AA5:AB35")) Is Nothing Then Exit Sub Application.EnableEvents = False Application.Undo Application.EnableEvents = True MsgBox "ダブルクリックで変更してください。" End Sub このコードの場合、AE5:AX35間は問題なく動くのですが、AA5:AB35をダブルクリックすると、 'Undo'ﾒｿｯﾄﾞは失敗しました '_Application'ｵﾌﾞｼﾞｪｸﾄ というエラーが出てしまいます。 ちなみに'---AA5:AB35の範囲はワークシートに直接の値変更不可以下のコードを削除した場合は、 Delete消しは当然出来てしまいますが、その他は理想通りの動きになります。 このままでも十分使用出来ますが、せっかくここまで教えていただいたので、 方法があれば教えていただけますでしょうか？ (MAKO) ---- 上側（ダブルクリックのコードの方）に 　Application.EnableEvents = True は有りますが 　Application.EnableEvents = False が抜けている様です。 ＞ If Not Application.Intersect(Target, Range("AA5:AB35")) Is Nothing Then ＞ Cancel = True 　★この部分にでも ＞ With Target 入れておけば動くと思いますよ。 ただ、↓の様に書いた方がすっきりしているのかもしれませんね。 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Dim flag As Object, flag2 As Object Const adr As String = "AE5:AE35,AF5:AF35,AL5:AL35,AR5:AR35,AX5:AX35" Const adr2 As String = "AA5:AB35" With Target Set flag = Application.Intersect(.Cells, Range(adr)) If Not flag Is Nothing Then Cancel = True If Not Intersect(.Cells, Range("AE5:AE35")) Is Nothing Then .Range("A1,B1,H1,N1,T1").Value = IIf(.Value = "■", "", "■") Else .Value = IIf(.Value = "■", "", "■") End If End If Set flag2 = Application.Intersect(.Cells, Range(adr2)) If Not flag2 Is Nothing Then Cancel = True Application.EnableEvents = False If .Value = "■" Then Range("AA" & .Row & ":AB" & .Row).Value = "■" .Value = "" Else Range("AA" & .Row & ":AB" & .Row).Value = "" .Value = "■" End If Application.EnableEvents = True End If End With End Sub Worksheet_Changeイベントの方は同じです。 (HANA) ---- HANAさん、ありがとうございます。 お礼のコメントが遅くなり申し訳ありませんでした。 ご提示いただいたコードで理想どおりの書式が出来ました。 結局、一からコードを作成していただく形になってしまい　すいません。 これから少しずつ勉強して、コードの意味が理解できるようにがんばりたいと思います。 また、ご指導よろしくお願いいたします。 (MAKO)