人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

お気持ちのみですが、合計で700ポイント程度の質問とさせて頂きます。

エクセルVBAのユーザーフォームを使ってコメント欄に示すインターフェースを実現して下さい。個人の特定の日時における行為を記録するツールです。

お力添えをよろしくお願い致します。

1231276215
●拡大する

●質問者: ReoReo7
●カテゴリ:コンピュータ ウェブ制作
✍キーワード:VBA インターフェース エクセル コメント欄 ポイント
○ 状態 :終了
└ 回答数 : 1/1件

▽最新の回答へ

1 ● SALINGER
●700ポイント ベストアンサー

わからない部分もあったのでこれでいいのかわかりませんが、ご指摘くだされば随時変更していきます。

コントロールの名称はたぶんそのままだと思います。

勝手に変更した部分は、複数選択するリストボックスだとクリックイベントを取得できないのでダブルクリックにしました。

それと、クリアボタンの処理はテキストボックスをクリアにしました。複数選択の場合、リストボックスをクリックしたほうが好きな項目を消せるので必要ないかなと。

5の処理はよくわからないので未実装です。

'クリアボタンの処理
Private Sub CommandButton1_Click()
 Dim i As Integer
 TextBox1.Value = ""
 For i = 0 To ListBox1.ListCount - 1
 ListBox1.Selected(i) = False
 Next i
End Sub

Private Sub CommandButton2_Click()
 Dim i As Integer
 TextBox2.Value = ""
 For i = 0 To ListBox2.ListCount - 1
 ListBox2.Selected(i) = False
 Next i
 For i = 0 To ListBox5.ListCount - 1
 ListBox5.Selected(i) = False
 Next i
 For i = 0 To ListBox7.ListCount - 1
 ListBox7.Selected(i) = False
 Next i
End Sub

Private Sub CommandButton3_Click()
 Dim i As Integer
 TextBox3.Value = ""
 For i = 0 To ListBox3.ListCount - 1
 ListBox3.Selected(i) = False
 Next i
End Sub

'リストボックスをダブルクリック
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
 Dim i As Integer
 Dim s As String
 For i = 0 To ListBox1.ListCount - 1
 If ListBox1.Selected(i) Then
 s = s & "," & ListBox1.List(i)
 End If
 Next i
 TextBox1.Value = Mid(s, 2)
 Sheet1.Range("D4").Value = TextBox1.Value
End Sub

Private Sub ListBox2_Click()
 Call MakeDate
End Sub

Private Sub ListBox3_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
 Dim i As Integer
 Dim s As String
 For i = 0 To ListBox3.ListCount - 1
 If ListBox3.Selected(i) Then
 s = s & "," & ListBox3.List(i)
 End If
 Next i
 TextBox3.Value = Mid(s, 2)
 Sheet1.Range("H4").Value = TextBox3.Value
End Sub

Private Sub ListBox5_Click()
 Call MakeDate
End Sub

Private Sub ListBox7_Click()
 Call MakeDate
End Sub

'日付はまとめて一つ関数で処理
Private Sub MakeDate()
 If ListBox2.ListIndex = -1 Then Exit Sub
 If ListBox5.ListIndex = -1 Then Exit Sub
 If ListBox7.ListIndex = -1 Then Exit Sub
 TextBox2.Value = ListBox7.Value & "/" & ListBox5.Value & "/" & ListBox2.Value
 
 If Not IsDate(TextBox2.Value) Then Exit Sub
 Dim myDate As Date
 myDate = DateValue(TextBox2.Value)
 Sheet1.Range("E4").Value = Year(myDate)
 Sheet1.Range("F4").Value = Month(myDate)
 Sheet1.Range("G4").Value = Day(myDate)
End Sub

'Enterを押したときの処理
Private Sub TextBox2_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
 If KeyCode <> vbKeyReturn Then Exit Sub
 If Not IsDate(TextBox2.Value) Then Exit Sub
 Dim myDate As Date
 myDate = DateValue(TextBox2.Value)
 Sheet1.Range("E4").Value = Year(myDate)
 Sheet1.Range("F4").Value = Month(myDate)
 Sheet1.Range("G4").Value = Day(myDate)
End Sub

Private Sub TextBox3_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
 If KeyCode <> vbKeyReturn Then Exit Sub
 Sheet1.Range("H4").Value = TextBox3.Value
End Sub

'ユーザーフォームを表示するときにリストを読み込む
Private Sub UserForm_Initialize()
 Dim i As Long
 Dim rastRow As Long
 rastRow = Sheet1.Cells(Rows.Count, 4).End(xlUp).Row
 For i = 7 To rastRow
 ListBox1.AddItem Sheet1.Cells(i, 4).Value
 Next i
 rastRow = Sheet1.Cells(Rows.Count, 7).End(xlUp).Row
 For i = 7 To rastRow
 ListBox2.AddItem Sheet1.Cells(i, 7).Value
 Next i
 rastRow = Sheet1.Cells(Rows.Count, 8).End(xlUp).Row
 For i = 7 To rastRow
 ListBox3.AddItem Sheet1.Cells(i, 8).Value
 Next i
 rastRow = Sheet1.Cells(Rows.Count, 3).End(xlUp).Row
 For i = 7 To rastRow
 ListBox4.AddItem Sheet1.Cells(i, 3).Value
 Next i
 rastRow = Sheet1.Cells(Rows.Count, 6).End(xlUp).Row
 For i = 7 To rastRow
 ListBox5.AddItem Sheet1.Cells(i, 6).Value
 Next i
 rastRow = Sheet1.Cells(Rows.Count, 2).End(xlUp).Row
 For i = 7 To rastRow
 ListBox6.AddItem Sheet1.Cells(i, 2).Value
 Next i
 rastRow = Sheet1.Cells(Rows.Count, 5).End(xlUp).Row
 For i = 7 To rastRow
 ListBox7.AddItem Sheet1.Cells(i, 5).Value
 Next i
 
  'テキストボックス1をロック、マルチラインの設定
 TextBox1.Locked = True
 ListBox1.MultiSelect = fmMultiSelectMulti
 ListBox3.MultiSelect = fmMultiSelectMulti
End Sub
◎質問者からの返答

!いつもありがとうございます。

早速実装してみます。

関連質問


●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ