Excel VBA 「カー計簿」リストボックスの実装
Excel VBA 「カー計簿」リストボックスの設置
リストボックスで明細行を表示させる
ツールボックスからリストボックスをドラッグアンドドロップし配置します。
リストボックスを設定します
リストボックスのオブジェクト名はList_Meisaiと定義しました。
リストボックス明細一覧の実装
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 |
Private Sub List_Meisai_Display() Worksheets("Temp").Select Dim wk_Line As Long Dim i As Integer wk_Line = Cells(Rows.Count, 1).End(xlUp).Row List_Meisai.Clear With List_Meisai .FontSize = 10 .ColumnCount = 12 .ColumnWidths = "30,30,0,70,100,80,230,120,140,40,40,40" .TextAlign = fmTextAlignLeft .Font.Name = "ＭＳ ゴシック" Worksheets("Temp").Range(Cells(2, 1), Cells(wk_Line, 11)) _ .Sort key1:=Worksheets("Temp").Cells(1, 4), Order1:=xlDescending For i = 2 To wk_Line .AddItem Cells(i, 1).Value .List(.ListCount - 1, 1) = Cells(i, 2).Value .List(.ListCount - 1, 2) = Cells(i, 3).Value .List(.ListCount - 1, 3) = Format(Cells(i, 4).Value, "yyyy/m/d") .List(.ListCount - 1, 4) = Cells(i, 5).Value .List(.ListCount - 1, 5) = Cells(i, 6).Value .List(.ListCount - 1, 6) = Cells(i, 7).Value .List(.ListCount - 1, 7) = Cells(i, 8).Value .List(.ListCount - 1, 8) = Cells(i, 9).Value .List(.ListCount - 1, 9) = Cells(i, 10).Value Next End With End Sub |
ワークシートTempデータをリストボックスに転記・表示させます。
リストボックスの明細表示
入力した明細が表示されます。
明細を選択クリックすると・・・
明細を選択クリックすると、変更処理を行うか聞いてきます。「はい」を選択すると変更や削除処理が可能となります。
はい。で修正・削除処理が可能となります。
終了ボタンの右側に修正ボタン、削除ボタンが生成され、明細行がテキストボックスなどに反映・表示されます。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 |
Sh_Data.Cells(Wk_DataLine, "D").Value = txt_Date Sh_Data.Cells(Wk_DataLine, "E").Value = Cmb_Bunrui Sh_Data.Cells(Wk_DataLine, "F").Value = Cmb_Komok.Text Sh_Data.Cells(Wk_DataLine, "G").Value = txt_Biko.Value Sh_Data.Cells(Wk_DataLine, "H").Value = txt_KinGaku.Value Sh_Data.Cells(Wk_DataLine, "K").Value = Date Sh_Data.Cells(Wk_DataLine, "L").Value = Time ''Sh_Temp.Cells(Wk_TempLine, "B").Value = "S" + CStr(Wk_NO) Sh_Temp.Cells(Wk_TempLine, "D").Value = txt_Date Sh_Temp.Cells(Wk_TempLine, "E").Value = Cmb_Bunrui Sh_Temp.Cells(Wk_TempLine, "F").Value = Cmb_Komok.Text Sh_Temp.Cells(Wk_TempLine, "G").Value = txt_Biko.Value Sh_Temp.Cells(Wk_TempLine, "H").Value = txt_KinGaku.Value Sh_Temp.Cells(Wk_TempLine, "K").Value = Date Sh_Temp.Cells(Wk_TempLine, "L").Value = Time If Cmb_Komok = CAR_WASH Then For w_i = 1 To Wk_MstLine If Sh_Mst.Cells(w_i, 13) = CAR_WASH Then wk_Line = w_i Sh_Mst.Cells(w_i, 14) = txt_Date wk_Nisuu = Sh_Mst.Cells(w_i, 16).Value Wk_Odo = Sh_Mst.Cells(w_i, 17).Value dtDate = txt_Date.Value Sh_Mst.Cells(w_i, 18) = DateAdd("d", wk_Nisuu, dtDate) Sh_Mst.Cells(w_i, 19) = Sh_Mst.Cells(w_i, 15).Value + Wk_Odo wk_date = Sh_Mst.Cells(3, 18).Value Wk_Odo = Sh_Mst.Cells(3, 19).Value lbl_NextChangOil.Caption = "次回オイル交換：" & wk_date & " (" & Wk_Odo & ")" wk_date = Sh_Mst.Cells(2, 18).Value Wk_Odo = Sh_Mst.Cells(2, 19).Value lbl_NextChangeWash.Caption = "次回洗車日：" & wk_date & " (" & Wk_Odo & ")" Exit For End If Next w_i End If If Cmb_Komok = OIL_CHANGE Then 中略 End If End If lbl_処理名.Caption = "入力処理" Cmb_Bunrui.Value = "" Cmb_Komok.Value = "" txt_KinGaku.Value = "" txt_Biko.Value = "" |
変更処理のソースリストは上記の通りです。入力した内容を各フィールドにセットしています。最後にラベルの処理名を入力処理とし、日付以外の項目はクリアされます。
