Results of 1 - 1 of about 978 for チェックボックス (0.008 sec.)
- [[20230930112723]]
- #score: 5499
- @digest: da6951df61cb92da58da92002951c2e3
- @id: 95190
- @mdate: 2023-09-30T09:58:26Z
- @size: 7579
- @type: text/plain
- #keywords: 準工 (40614), 殊工 (38796), 事" (38684), 帯工 (37491), 付帯 (23027), 事□ (22494), 準7 (22142), listbox2 (21030), checkbox5 (18846), 動-- (18382), checkbox6 (17225), 工事 (14600), ー安 (14214), removeitem (12654), checkbox2 (11392), fmmultiselectmulti (9401), 択-- (9131), 全対 (7862), listbox1 (6190), クボ (6057), ス2 (6014), selected (4682), 特殊 (4666), multiselect (4507), トボ (4217), listcount (3828), ボッ (3721), columnwidths (3526), イダ (3509), ス1 (3175), クス (2987), additem (2849)
- 『VBAのユーザーフォームについて質問です。』（まき）
チェックボックスが複数あり、該当のチェックボックスをチェックすると リストボックス1にチェックボックスと同じ値が表示され、 リストボックス2はそれに連動した値が選択できるようになっています。 複数のチェックボックスにチェックした状態で、 リストボックス2で複数選択の値の保持して、シート1のE列に転記したいです。 例） ■ユーザーフォーム --------------------------------------------------------------------------------- 【チェックボックス】 ☑標準工事 ☑特殊工事 □付帯工事 □部品交換 ←チェックすると下のリストボックスが1→2の順で □電気工事 □キャンセル 連動するようになっています。 【リストボックス1】 【リストボックス2】 標準工事 標準4.9以下 標準7.1以下 ←これを選択 標準7.2以上 *********************************************************** 特殊工事 屋上設置 高所作業料 スライダー安全対策←これを選択 --------------------------------------------------------------------------------- シート1のD列最終行+1に"標準7.1以下"、その下の行に"スライダー安全対策"と続けて転記したい リストボックス1を跨ぐリストボックス2の複数の値選択は可能なのでしょうか。 また、自分で書いた下記のコードですと、リストボックス2の値が上書きされてしまいます。 どのように修正したらよいか教えてください。 Private Sub CommandButton1_Click() Dim ctrl As Control 'ユーザーフォームのコントロールをループ For Each ctrl In Controls If InStr(ctrl.Name, "CheckBox") <> 0 Then 'チェックボックスがオンだったら If ctrl.Value = True Then 'D列の最終行にチェックボックスのCaptionを転記 Cells(Cells(Rows.Count, 4).End(xlUp).Row + 1, 4) = ctrl.Caption 'E列の最終行に選択したリストボックスの値を転記 For i = 0 To ListBox2.ListCount - 1 If ListBox2.Selected(i) Then With Worksheets("Sheet1") 'C列最終行を取得 LastRow = .Cells(Rows.Count, 4).End(xlUp).Row 'セルへ転記 .Cells(LastRow, 5) = ListBox2.List(i) LastRow = LastRow + 1 End With End If Next End If End If Next ctrl End Sub '--------------チェックボックスとリスト連動---------- '**【1】 'Private Sub CheckBox1_Change() ' ' With ListBox1 ' If CheckBox1.Value Then ' .AddItem Worksheets("Sheet2").Range("A2").Value 'チェックボックス【1】が"標準工事"だったら ' Else ' .RemoveItem 0 ' End If ' End With ' 'End Sub '------リストから複数選択--------- Private Sub UserForm_Initialize() With ListBox1 With ListBox2 .MultiSelect = fmMultiSelectMulti ' 'チェックボックス表示 ' .ListStyle = fmListStyleOption End With End With End Sub '--------------リストボックス1とリストボックス2連動---------- Private Sub ListBox1_Change() ListBox2.Clear Select Case ListBox1.Text Case "標準工事" ListBox2.List = Worksheets("Sheet2").Range("B2:B6").Value Case "付帯工事" ListBox2.List = Worksheets("Sheet2").Range("B7:B20").Value Case "特殊工事" ListBox2.List = Worksheets("Sheet2").Range("B21:B44").Value End Select End Sub '-------【標準工事】------- Private Sub CheckBox2_Change() If CheckBox2.Value = True Then AAA = UserForm1.CheckBox2.Caption ElseIf CheckBox2.Value = False Then End If With ListBox1 Select Case AAA Case "標準工事" End Select If CheckBox2.Value = True Then .AddItem Worksheets("Sheet2").Range("A2").Value Else .RemoveItem 0 ListBox2.Clear End If End With End Sub '-------【付帯工事】------- Private Sub CheckBox5_Change() If CheckBox5.Value = True Then AAA = UserForm1.CheckBox5.Caption ElseIf CheckBox2.Value = False Then End If With ListBox1 Select Case AAA Case "付帯工事" End Select If CheckBox5.Value = True Then .AddItem Worksheets("Sheet2").Range("A7").Value Else .RemoveItem 0 ListBox2.Clear End If End With End Sub '-------【特殊工事】------- Private Sub CheckBox6_Change() If CheckBox6.Value = True Then AAA = UserForm1.CheckBox5.Caption ElseIf CheckBox6.Value = False Then End If With ListBox1 Select Case AAA Case "特殊工事" End Select If CheckBox6.Value = True Then .AddItem Worksheets("Sheet2").Range("A21").Value Else .RemoveItem 0 ListBox2.Clear End If End With End Sub ＜ 使用 Excel:Excel2016、使用 OS:Windows10 ＞ ---- 該当部のみ修正してみました。 ListBox2にも工事の種類を表示した方がよければ、 UserForm_Initializeの.ColumnWidths = "0;" を50とかに変更。 それでOKならListBox1は要らないと思いますけど・・・ '------リストから複数選択--------- Private Sub UserForm_Initialize() ListBox1.MultiSelect = fmMultiSelectMulti With ListBox2 .MultiSelect = fmMultiSelectMulti .ColumnCount = 2 .ColumnWidths = "0;" End With End Sub '--------------リストボックス1とリストボックス2連動---------- Private Sub ListBox1_Change() Dim i As Long, n As Long, v(), arr() Dim r As Range, rng As Range, tmp As Range Dim str As String ListBox2.Clear ReDim v(0) With ListBox1 For i = 0 To .ListCount - 1 If .Selected(i) Then ReDim Preserve v(n) v(n) = .List(i) n = n + 1 End If Next End With For i = 0 To UBound(v) Select Case v(i) Case "標準工事" Set tmp = Worksheets("Sheet2").Range("A2:B6") Case "付帯工事" Set tmp = Worksheets("Sheet2").Range("A7:B20") Case "特殊工事" Set tmp = Worksheets("Sheet2").Range("A21:B44") End Select If rng Is Nothing Then Set rng = tmp Else Set rng = Union(rng, tmp) End If Next n = 0 If Not rng Is Nothing Then For Each r In rng.Rows If r.Cells(1).Value <> "" Then str = r.Cells(1) If Not r.Cells(2) = "" Then n = n + 1 ReDim Preserve arr(1 To 2, 1 To n) arr(1, n) = str arr(2, n) = r.Cells(2) End If Next ListBox2.List = Application.Transpose(arr) End If End Sub '--------------コマンドボタン2を設置して実行---------- Private Sub CommandButton2_Click() Dim i As Long, n As Long, v() With ListBox2 For i = 0 To .ListCount - 1 If .Selected(i) Then n = n + 1 ReDim Preserve v(1 To 2, 1 To n) v(1, n) = .List(i, 0) v(2, n) = .List(i, 1) End If Next End With On Error Resume Next Worksheets("Sheet1").Cells(Rows.Count, "D").End(xlUp) _ .Offset(1).Resize(UBound(v, 2), 2) = Application.Transpose(v) On Error GoTo 0 End Sub （サラスパ） 2023/09/30(土) 16:19:19 ---- チェックボックスが全て☑されたらどうするの。 その対策は。 （?） 2023/09/30(土) 18:58:26... - http://www.excel.studio-kazu.jp/wiki/kazuwiki/202309/20230930112723.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 97004 documents and 608067 words.
訪問者：