教えて VBA（チェックボックス）利用の構文-2

質問

チェックボックスが28個並んでいますが
一つ一つ設定する必要があるのでしょうか？

回答No.3

nishi6

また48個になりました？

＞教えていただいたものを実行させていただきましたが”1”が反映されなかったので
　一応、添付図のようにテストをしているので、「1」が表示されないことはないはずですが・・・
ただ、チェックボックスをオン・オフした時点でシートに記入はしていません。それこそ48個のイベントか新たなクラスを定義したりすることが必要になります。

＞この作業を1～100まで続けたいのです。
＞（100行まで無く途中で登録終了する場合あり）
　また変更（追加？）のように思えますが、
　　連続入力したい、途中で中断あり、ということは、「途中再開あり、修正もあり」になりそうです。こういうのは最初から分かっていれば簡単なんですが。

　以下、自分ならこうするだろうと思うフォームとモジュールを書いてみました。多分、質問者様も自分のフォームを作っておられると思いますが、とりあえず、私の考えたフォームの前提で稼働を確認してください。

【フォームの内容】
チェックボック＿＿４個（CheckBox1、CheckBox2・・・）
　　後で48個に増やしてください。そのときは、コードの個数も増やしてください。
　　　[ユーザーフォームのコードウィンドウ]　下の「48」です。
　　　Const chkboxNum = 48 'テストは4で実行、本当は48

ラベル＿＿＿＿＿＿１個（Label1）
　　入力が何行目かを表示します。

コマンドボタン＿＿４個（CommandButton1、CommandButton2・・・）
　Caption:登録(継続)＿＿（CommandButton1）
　　　チェックボックスの状態を入力行に反映します。
　　　反映後、次の行の入力になります。
　　　入力済みなら訂正になります。
　　　100件超は入力不可です。
　Caption:登録して終了＿（CommandButton2）
　　　登録してフォームを閉じます。
　Caption:スキップ＿＿＿（CommandButton3）
　　　何もしないで次の行への入力に移ります。
　　　行の下への動きのみです。上へはスキップしません。
　　　100件超はスキップできません。
　Caption:キャンセル＿＿（CommandButton4）
　　　何もしないでフォームを閉じます。
　　　入力行でのチェックボックスの変更は無効になります。

[Sheet1のコードウィンドウ]
'入力エリアでダブルクリックでフォームを立ち上げる
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
　　'CheckBox48個がB列～AW列に対応
　　If Not (Application.Intersect(Range("B2:AW101"), Target) Is Nothing) Then
　　　　WriteRow = Target.Row
　　　　UserForm1.Show
　　End If
End Sub

[標準モジュールのコードウィンドウ]
Public WriteRow As Long '書き出す行

[ユーザーフォームのコードウィンドウ]
Const chkboxNum = 4 '本当は48
Const maxData = 100 '最大入力データ数

'*************************************
'登録処理（登録[継続]　ボタン）
'*************************************
Private Sub CommandButton1_Click()
　　Call Touroku

　　WriteRow = WriteRow + 1 '次の行
　　Range("A" & WriteRow).Select
　　Call readSetData
End Sub

'*************************************
'登録処理（登録[終了]　ボタン）
'*************************************
Private Sub CommandButton2_Click()
　　Call Touroku

　　Unload Me
　　Range("B" & WriteRow).Select
End Sub

　　'*************************************
　　'登録処理（シートに書き出す）
　　'*************************************
　　Sub Touroku()
　　　　Dim i As Integer

　　　　For i = 1 To chkboxNum
　　　　　　With Controls("CheckBox" & i)
　　　　　　　　If .Value = True Then
　　　　　　　　　　Range(.Tag & WriteRow) = 1
　　　　　　　　Else
　　　　　　　　　　Range(.Tag & WriteRow) = ""
　　　　　　　　End If
　　　　　　End With
　　　　Next
　　End Sub

'*************************************
'スキップ（スキップ　ボタン）
'*************************************
Private Sub CommandButton3_Click()
　　WriteRow = WriteRow + 1 '次の行
　　Range("A" & WriteRow).Select
　　Call readSetData
End Sub

'*************************************
'キャンセル（キャンセル　ボタン）
'*************************************
Private Sub CommandButton4_Click()
　　Unload Me
　　Range("B" & WriteRow).Select
End Sub

'*************************************
'フォーム立ち上げ時の処理
'*************************************
Private Sub UserForm_Initialize()
　　Call readSetData
End Sub

　　'*************************************
　　'登録済みのデータを読み込む
　　'*************************************
　　Private Sub readSetData()
　　　　Dim i As Integer

　　　　If maxData < (WriteRow - 1) Then
　　　　　　MsgBox "入力は " & maxData & " 件 までです。終了します"
　　　　　　Unload Me
　　　　　　Exit Sub
　　　　End If

　　　　For i = 1 To chkboxNum
　　　　　　With Controls("CheckBox" & i)
　　　　　　　　If Range(.Tag & WriteRow) = 1 Then
　　　　　　　　　　.Value = True
　　　　　　　　Else
　　　　　　　　　　.Value = False
　　　　　　　　End If
　　　　　　End With
　　　　Next

　　　　'何件目か表示する
　　　　Label1.Caption = (WriteRow - 1) & " 件目"
　　End Sub

お礼

初心者の私にわかりやすく教授していただき、ありがとうございました。

また、チェックボックス数も増減してしまいすみませんでした。
質問の説明も足りないなかで、ご回答していただき感謝しております。
もっと勉強したいと思います。
今回はありがとうございました。

回答No.2

nishi6

チェックボックスの値を書き出すセル位置（行）を変える必要があることと、設定済みの行でフォームを開いた場合、セルの値をチェックボックスに取り込む必要があります。また、Trueを「1」、Falseを「未入力（長さ0の文字列にしました）」にしたいとのことなので、「ControlSource」には何もセットしません。（最初の質問の趣旨のはず）

その変わりに、各チェックボックスの「Tag」プロパティに出力したい列名を登録します。

チェックボックス名はCheckBox1、CheckBox2、CheckBox3・・・ となっており、TagプロパティはB、C、D・・・と設定します。

フォームの立ち上げはSheet1の出力範囲でのダブルクリックとしています。B列からAC列の28列とその2行目から10000行までをその範囲にしています。（最初は48列でした？）

3つの質問で何をしたいか分からなくなりました。そのためかなりテキトーになってしまったきらいがあります。特に「教えて　VBA（チェックボックス）利用の構文-2」で最初の質問はなしになった？

[Sheet1のコードウィンドウ]
'入力エリアでダブルクリックでフォームを立ち上げる
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
　　'CheckBox28個がB列～AC列に対応
　　If Not (Application.Intersect(Range("B2:AC10000"), Target) Is Nothing) Then
　　　　WriteRow = Target.Row
　　　　UserForm1.Show
　　End If
End Sub

[標準モジュールのコードウィンドウ]
Public WriteRow As Long '書き出す行

[ユーザーフォームのコードウィンドウ]
Const chkboxNum = 28 '添付図は4

'決定時の処理
Private Sub CommandButton1_Click()
　　Dim i As Integer

　　For i = 1 To chkboxNum
　　　　With Controls("CheckBox" & i)
　　　　　　If .Value = True Then
　　　　　　　　Range(.Tag & WriteRow) = 1
　　　　　　Else
　　　　　　　　Range(.Tag & WriteRow) = ""
　　　　　　End If
　　　　End With
　　Next

　　Unload Me
　　Range("A" & WriteRow).Select
End Sub

'フォーム立ち上げ時の処理
Private Sub UserForm_Initialize()
　　Dim i As Integer

　　For i = 1 To chkboxNum
　　　　With Controls("CheckBox" & i)
　　　　　　If Range(.Tag & WriteRow) = 1 Then
　　　　　　　　.Value = True
　　　　　　Else
　　　　　　　　.Value = False
　　　　　　End If
　　　　End With
　　Next
End Sub

補足

ご回答ありがとうございます。

勉強初心者でとても助かります。

添付ファイルのとおりで
　UserFormは
「たぬき」「きつね」・・・のように48個のチェックボックスがあります。

このチェックボックスにチェックが入ったら”1”　なければ””

48個のチェックが終了したら登録を押すことでExcelに反映する。

この作業を1~100まで続けたいのです。
（100行まで無く途中で登録終了する場合あり）

教えていただいたものを実行させていただきましたが
”1”が反映されなかったので
すみませんが再度お教えください。
よろしくお願いします。

回答No.1

keithin

たとえばそれぞれのチェックボックスについて、プロパティウィンドウでControlSourceに例えば
Sheet1!B2
Sheet1!C2
　：
などのように各々設定しておくことで、それぞれのチェックボックスの結果をシートのセルに一つずつ書き出させるといった設定が出来ます。