teratail
回答率
85.36%
teratail header banner
teratail header banner
質問するログイン新規登録

『🎄teratailクリスマスプレゼントキャンペーン2024🎄』開催中！

＼teratail特別グッズやAmazonギフトカード最大2,000円分が当たる！／

詳細はこちら
トップVBAに関する質問
VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

マクロ

定義された処理手続きに応じて、どのような一連の処理を行うのかを特定させるルールをマクロと呼びます。

Q&A

解決済

2回答

3829閲覧

VBA　複数のチェックボックスのうちどれか一つを選択したときセルへ反映させる

cra
cra

総合スコア4

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

マクロ

定義された処理手続きに応じて、どのような一連の処理を行うのかを特定させるルールをマクロと呼びます。

0グッド

0クリップ

投稿2021/03/15 06:28

0

0

前提・実現したいこと

VBA　ユーザーフォーム内　チェックボックスに関しての
質問です

ユーザーフォームで複数のチェックボックスを使用し
ひとつのセルへ文字を返したいです

3つの選択肢のうちどれか一つを選んだら
その項目がセルに表示される　といったかたちにしたいです
チェックボックスのキャプション名がそのまま
セルに反映されるといったものがいいです

VBAは不慣れなのでぜひおしえてください

発生している問題・エラーメッセージ

エラーメッセージ

該当のソースコード

Private Sub CommandButton1_Click()

If Me.CheckBox1.Value = True Then
ActiveCell.Value = Me.CheckBox1.Caption
End If

If Me.CheckBox2.Value = True Then
If ActiveCell.Value = "" Then
ActiveCell.Value = Me.CheckBox2.Caption
Else
ActiveCell.Value = vbLf & Me.CheckBox2.Caption
End If
End If

If Me.CheckBox3.Value = True Then
If ActiveCell.Value = "" Then
ActiveCell.Value = Me.CheckBox3.Caption
Else
ActiveCell.Value = vbLf & Me.CheckBox3.Caption
End If
End If

End Sub

MsgBox "登録しました。", vbInformation + vbOKOnly, "Information"      '← 登録メッセージ表示

End Sub


### 試したこと

ここに問題に対して試したことを記載してください。

### 補足情報（FW/ツールのバージョンなど）

ここにより詳細な情報を記載してください。

気になる質問をクリップする

クリップした質問は、後からいつでもMYページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

guest

回答2件

0

ベストアンサー

こんな感じでどうでしょうか。

VBA
1Function CheckBoxCaptionToCellValue()
2    Dim arr(1 To 3)
3    If Me.CheckBox1.Value Then arr(1) = Me.CheckBox1.Caption
4    If Me.CheckBox2.Value Then arr(2) = Me.CheckBox2.Caption
5    If Me.CheckBox3.Value Then arr(3) = Me.CheckBox3.Caption
6    
7    ActiveCell.Value = WorksheetFunction.TextJoin(vbLf, True, arr)
8End Function
9
10
11Private Sub CheckBox1_Click()
12    CheckBoxCaptionToCellValue
13End Sub
14Private Sub CheckBox2_Click()
15    CheckBoxCaptionToCellValue
16End Sub
17Private Sub CheckBox3_Click()
18    CheckBoxCaptionToCellValue
19End Sub
20

＜追記＞
ExcelがTextJoinに対応していない場合は以下の感じで。

VBA
1Function CheckBoxCaptionToCellValue()
2    Dim buf
3    If Me.CheckBox1.Value Then buf = buf & vbLf & Me.CheckBox1.Caption
4    If Me.CheckBox2.Value Then buf = buf & vbLf & Me.CheckBox2.Caption
5    If Me.CheckBox3.Value Then buf = buf & vbLf & Me.CheckBox3.Caption
6    buf = Mid(buf, 2)
7    Range("A1").Value = buf
8End Function

投稿2021/03/15 06:49

編集2021/03/15 08:07
jinoji
jinoji

総合スコア4592

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

cra
cra

2021/03/15 07:24

ありがとうございます こちらをいれてみたところ > ActiveCell.Value = Worksheets("ワークシート名").TextJoin(vbLf, True, arr) 483エラー　メソッドのサポートを・・・といったエラーがかえってきます あとtextjoinで区切るのではなく CheckBox1の名称が例えばみかんだった場合 チェックいれたらセルにみかんが表示されるように したいです
cra
cra

2021/03/15 07:26

すみません　こちらのミスです　できました 変な改行？が入るのはどうしたらいいですか Function CheckBoxCaptionToCellValue() Dim arr(1 To 3) If Me.CheckBox1.Value Then arr(1) = Me.CheckBox1.Caption If Me.CheckBox2.Value Then arr(2) = Me.CheckBox2.Caption If Me.CheckBox3.Value Then arr(3) = Me.CheckBox3.Caption ActiveCell.Value = ActiveCell.Value & vbLf & Me.CheckBox2.Caption End Function Private Sub CheckBox1_Click() CheckBoxCaptionToCellValue End Sub Private Sub CheckBox2_Click() CheckBoxCaptionToCellValue End Sub Private Sub CheckBox3_Click() CheckBoxCaptionToCellValue End Sub
cra
cra

2021/03/15 07:31

セル一行に入力しているのに 「 みかん」 というかんじで入力されています
jinoji
jinoji

2021/03/15 07:48

A1セルに入れたいなら、 Range("A1").Value = WorksheetFunction.TextJoin(vbLf, True, arr) なお、ExcelのバージョンによってはTextJoinが使えません。 そのときは別のやり方で。
cra
cra

2021/03/15 07:51

・ユーザーフォームにて入力画面をつくっています 入力が楽になるようチェックボックスで項目選択させたいのですが TRUE以外の返事をセルに返して欲しいと思い質問しました 全文のせておきます Private Sub UserForm_Initialize() Me.lbl行番号.Caption = Worksheets("ワークシート名").Range("A1").CurrentRegion.Rows.Count + 1 End Sub Private Sub cmd先頭移動_Click() '← [ |< ]ボタンを押下した時の処理追加 Call DspDataSet(2) End Sub Private Sub cmd前移動_Click() If Me.lbl行番号 > 1 Then Call DspDataSet(Me.lbl行番号 - 1) Else Call DspDataSet(1) End If End Sub Private Sub cmd次移動_Click() Dim wMaxRow As Long wMaxRow = Worksheets("ワークシート").Range("A1").CurrentRegion.Rows.Count '← 最終行番号 If Me.lbl行番号 < wMaxRow Then Call DspDataSet(Me.lbl行番号 + 1) Else Call DspDataSet(wMaxRow) End If End Sub Private Sub cmd最終移動_Click() Dim wMaxRow As Long wMaxRow = Worksheets("ワークシート").Range("A1").CurrentRegion.Rows.Count '← 最終行番号 Call DspDataSet(wMaxRow) End Sub Private Sub cmd新規_Click() Call DspDataSet(0) ' End Sub Private Sub cmd検索_Click() frm顧客検索.Show vbModal If rtnNo > 1 Then With Worksheets("ワークシート") Me.lbl行番号.Caption = rtnNo Me.txt顧客番号 = .Cells(rtnNo, 1) Me.txtふりがな = .Cells(rtnNo, 2) Me.txt名前 = .Cells(rtnNo, 3) Me.txt郵便番号 = .Cells(rtnNo, 4) Me.txt住所 = .Cells(rtnNo, 5) Me.txt電話番号 = .Cells(rtnNo, 6) Me.txt電話番号2 = .Cells(rtnNo, 7) Me.txt受付日 = .Cells(rtnNo, 8) Me.txt担当 = .Cells(rtnNo, 9) Me.txt見積金額 = .Cells(rtnNo, 10) Me.txt内金 = .Cells(rtnNo, 11) Me.txt増 = .Cells(rtnNo, 12) Me.txt減 = .Cells(rtnNo, 13) Me.txtチップ = .Cells(rtnNo, 14) End With End If End Sub Private Sub cmd登録_Click() '← 登録ボタン押下時の処理 Dim wRow As Long If Me.txt顧客番号 = "" Then MsgBox "顧客番号を入力してください。", vbExclamation + vbOKOnly, "入力エラー" Exit Sub End If If Me.txt名前 = "" Then MsgBox "名前を入力してください。", vbExclamation + vbOKOnly, "入力エラー" Exit Sub End If 'フォーム上の各データをシートへ送る With Worksheets("ワークシート") wRow = Me.lbl行番号.Caption .Cells(wRow, 1) = Me.txt顧客番号 .Cells(wRow, 2) = Me.txtふりがな .Cells(wRow, 3) = Me.txt名前 .Cells(wRow, 4) = Me.txt郵便番号 .Cells(wRow, 5) = Me.txt住所 .Cells(wRow, 6) = Me.txt電話番号 .Cells(wRow, 7) = Me.txt電話番号2 .Cells(wRow, 8) = Me.txt受付日 .Cells(wRow, 9) = Me.txt担当 .Cells(wRow, 10) = Me.txt見積金額 .Cells(wRow, 11) = Me.txt内金 .Cells(wRow, 12) = Me.txt増 .Cells(wRow, 13) = Me.txt減 .Cells(wRow, 14) = Me.txtチップ End With MsgBox "登録しました。", vbInformation + vbOKOnly, "Information" '← 登録メッセージ表示 End Sub Function CheckBoxCaptionToCellValue() Dim arr(1 To 3) If Me.CheckBox1.Value Then arr(1) = Me.CheckBox1.Caption If Me.CheckBox2.Value Then arr(2) = Me.CheckBox2.Caption If Me.CheckBox3.Value Then arr(3) = Me.CheckBox3.Caption ActiveCell.Value = ActiveCell.Value & vbLf & Me.CheckBox1 CheckBox2.Me.CheckBox3.Caption End Function Private Sub CheckBox1_Click() CheckBoxCaptionToCellValue End Sub Private Sub CheckBox2_Click() CheckBoxCaptionToCellValue End Sub Private Sub CheckBox3_Click() CheckBoxCaptionToCellValue End Sub Private Sub DspDataSet(prmNo) With Worksheets("ワークシート") If prmNo > 1 Then Me.lbl行番号.Caption = prmNo Me.txt顧客番号 = .Cells(prmNo, 1) Me.txtふりがな = .Cells(prmNo, 2) Me.txt名前 = .Cells(prmNo, 3) Me.txt郵便番号 = .Cells(prmNo, 4) Me.txt住所 = .Cells(prmNo, 5) Me.txt電話番号 = .Cells(prmNo, 6) Me.txt電話番号2 = .Cells(prmNo, 7) Me.txt受付日 = .Cells(prmNo, 8) Me.txt担当 = .Cells(prmNo, 9) Me.txt見積金額 = .Cells(prmNo, 10) Me.txt内金 = .Cells(prmNo, 11) Me.txt増 = .Cells(prmNo, 12) Me.txt減 = .Cells(prmNo, 13) Me.txtチップ = .Cells(prmNo, 14) Else Me.lbl行番号.Caption = .Range("A1").CurrentRegion.Rows.Count + 1 Me.txt顧客番号 = "" Me.txtふりがな = "" Me.txt名前 = "" Me.txt郵便番号 = "" Me.txt住所 = "" Me.txt電話番号 = "" Me.txt電話番号2 = "" Me.txt受付日 = "" Me.txt担当 = "" Me.txt見積金額 = "" Me.txt内金 = "" Me.txt増 = "" Me.txt減 = "" Me.txtチップ = "" End If End With End Sub
cra
cra

2021/03/15 07:59

バージョンは2016です Range("R2").Value = Worksheets("ワークシート").Function.TextJoin(vbLf, True, arr) これでエラーがでます ワークシート名はここに書き込むときだけ変えているので 本文のほうではそこでのエラーはないとおもいます
jinoji
jinoji

2021/03/15 08:11

Range("R2").Value = WorksheetFunction.TextJoin(vbLf, True, arr)　です。
cra
cra

2021/03/16 01:09

textjoinは対応されてないみたいです
cra
cra

2021/03/16 01:14

Function CheckBoxCaptionToCellValue() Dim buf If Me.CheckBox1.Value Then buf = buf & vbLf & Me.CheckBox1.Caption If Me.CheckBox2.Value Then buf = buf & vbLf & Me.CheckBox2.Caption If Me.CheckBox3.Value Then buf = buf & vbLf & Me.CheckBox3.Caption buf = Mid(buf, 2) Range("R2").Value = buf End Function を入力したのですが　フォームでは問題ないのですが セルに反映されません
jinoji
jinoji

2021/03/16 01:16

＞textjoinは対応されてないみたいです あれ、そうですか？ Excel2016なら対応してると思いましたが・・・
cra
cra

2021/03/16 01:22

メソッドに対応していないというエラーポップアップがでてきます・・・
jinoji
jinoji

2021/03/16 01:33

再確認ですが Range("R2").Value = Worksheets("ワークシート").Function.TextJoin(vbLf, True, arr) ではなく Range("R2").Value = WorksheetFunction.TextJoin(vbLf, True, arr) です。そこは修正済みですか？ まあ、Textjoinを使わない方法でやればいいんですが。
jinoji
jinoji

2021/03/16 01:36

セルに反映されません、とのことですが、 Worksheets("ワークシート").Range("R2").Value = buf としたら改善されますか？
cra
cra

2021/03/16 01:42

>Range("R2").Value = WorksheetFunction.TextJoin(vbLf, True, arr) だとエラーが出ますが Function CheckBoxCaptionToCellValue() Dim arr(1 To 3) If Me.CheckBox1.Value Then arr(1) = Me.CheckBox1.Caption If Me.CheckBox2.Value Then arr(2) = Me.CheckBox2.Caption If Me.CheckBox3.Value Then arr(3) = Me.CheckBox3.Caption Worksheets("ワークシート").Range("R2").Value = buf End Function にするとエラー無く動きます ただセルには反映されません （チェックボックスは触れるし複数選択もできているのですが・・・）
jinoji
jinoji

2021/03/16 02:06

セルへの反映は、チェックボックスを触ったときか、コマンドボタンを押したときか、 どちらのタイミングで行う想定ですか？
jinoji
jinoji

2021/03/16 02:09

Private Sub CheckBox1_Click() CheckBoxCaptionToCellValue End Sub Private Sub CheckBox2_Click() CheckBoxCaptionToCellValue End Sub Private Sub CheckBox3_Click() CheckBoxCaptionToCellValue End Sub
cra
cra

2021/03/16 02:30

Function CheckBoxCaptionToCellValue() Dim arr(1 To 3) Worksheets("顧客情報").Range("R2").Value = buf End Function Private Sub CheckBox1_Click() CheckBoxCaptionToCellValue End Sub Private Sub CheckBox2_Click() CheckBoxCaptionToCellValue End Sub Private Sub CheckBox3_Click() CheckBoxCaptionToCellValue End Sub にしてエラー無く動きますが反映されません cmd登録を押した瞬間に反映されてほしいです
jinoji
jinoji

2021/03/16 03:16

Function CheckBoxCaptionToCellValue() Dim buf If Me.CheckBox1.Value Then buf = buf & vbLf & Me.CheckBox1.Caption If Me.CheckBox2.Value Then buf = buf & vbLf & Me.CheckBox2.Caption If Me.CheckBox3.Value Then buf = buf & vbLf & Me.CheckBox3.Caption buf = Mid(buf, 2) Worksheets("顧客情報").Range("R2").Value = buf End Function Private Sub CheckBox1_Click() CheckBoxCaptionToCellValue End Sub Private Sub CheckBox2_Click() CheckBoxCaptionToCellValue End Sub Private Sub CheckBox3_Click() CheckBoxCaptionToCellValue End Sub Private Sub cmd検索_Click() CheckBoxCaptionToCellValue '以下略 End Sub
cra
cra

2021/03/16 04:31

ありがとうございます！表示されました！ ただデータを呼び出してきても新規で入力しても R2に書き込まれてしまいます
jinoji
jinoji

2021/03/16 06:24

データを呼び出してきても新規で入力しても、の意味がわかりませんが、 cmd検索_ClickのときだけR2書き込みとするなら、以下の行は不要です。 （チェックボックスをクリックしたときにR2に反映させるための記述なので） Private Sub CheckBox1_Click() CheckBoxCaptionToCellValue End Sub Private Sub CheckBox2_Click() CheckBoxCaptionToCellValue End Sub Private Sub CheckBox3_Click() CheckBoxCaptionToCellValue End Sub
cra
cra

2021/03/18 02:57

Function CheckBoxCaptionToCellValue() Dim buf If Me.CheckBox1.Value Then buf = buf & vbLf & Me.CheckBox1.Caption If Me.CheckBox2.Value Then buf = buf & vbLf & Me.CheckBox2.Caption If Me.CheckBox3.Value Then buf = buf & vbLf & Me.CheckBox3.Caption buf = Mid(buf, 2) Worksheets("顧客情報").Range("J2").Value = buf End Function （J列に変更しました） あれから色々ためしましてセルへチェックボックスの内容が表示されるようには なったのですが、J2セル固定で、他のJ3 J4・・・・にはFALSEが表示されて しまいます。 上の回答であった部分を削除もしたのですがうまくいかず・・・
cra
cra

2021/03/18 02:58

フォームで新規データ入力すると　Ｊ２の表記が変わってしまいます
jinoji
jinoji

2021/03/18 03:01

ボタンを押すたびにJ列の最下行の空白セルに値を入れたいならこんな感じ。 Worksheets("顧客情報").Cells(Rows.Count, "J").End(xlUp).Offset(1).Value = buf
cra
cra

2021/03/18 05:42

ありがとうございます！うまくいきました フォームで登録データの修正をしようとするとデータの入力されている行とは別に 最下行の空白セルのデータが入ってしまいます
jinoji
jinoji

2021/03/18 05:54

つまり、やりたいのは、 If 新規追加 Then 行No = Worksheets("顧客情報").Cells(Rows.Count, "J").End(xlUp).Row + 1 Else 行No = 修正しているデータの行 End If Worksheets("顧客情報").Cells( 行No , "J").Value = buf 、、的なことですか？
cra
cra

2021/03/18 06:30

そうです！！ながながとすみません
jinoji
jinoji

2021/03/18 06:42

wRow という変数が上で言う行No に相当するもので、 新規の場合も修正の時でも既に書き出したい行の行番号が入った状態なのだとしたら、 たんに Worksheets("顧客情報").Cells( wRow , "J").Value = buf とすればよいということになりそうですね。
cra
cra

2021/03/18 06:57

修正したいデータを呼び出すときのコードが わからないです　 If prmNo > 1 Then Me.lbl行番号.Caption = prmNo とかでしょうか・・・・？
jinoji
jinoji

2021/03/18 14:57

それはもう別の質問にした方がよいかも。
cra
cra

2021/03/19 00:09

了解です　ありがとうございます
guest

0

複数チェックが入っている時にそれぞれのキャプションを改行して反映させたいなら
「ActiveCell.Value &」としなければなりません。
意図と違ったら申し訳ないです。

vba
1ActiveCell.Value =ActiveCell.Value & vbLf & Me.CheckBox2.Caption

投稿2021/03/15 06:46

radames1000
radames1000

総合スコア1925

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

cra
cra

2021/03/15 07:43

ありがとうございます アクティブセルではなく指定した列へ流し込みたいです あと何を入れても同じ文言しかはいりません・・・ CheckBox1の言葉は入っているのですが CheckBox2を選択しても1の言葉を返してきます
guest

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

質問の解決につながる回答をしましょう。 サンプルコードなど、より具体的な説明があると質問者の理解の助けになります。 また、読む側のことを考えた、分かりやすい文章を心がけましょう。

15分調べてもわからないことは
teratailで質問しよう！

ただいまの回答率
85.36%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問

トップVBAに関する質問

VBA　複数のチェックボックスのうちどれか一つを選択したときセルへ反映させる