0

度々で恐縮ですがリストボックスに表示されているリストを選択した時に
選択されているリストを含む以下の件数をテキストボックスで表示させることは
可能でしょうか? 例 2012/07/07が選択されたら6枚と表示
2012/07/12が選択されたら1枚と表示


Private Sub UserForm_Initialize()

Me.StartUpPosition = 0
Me.Left = 586
Me.Top = 138

'タイトルを設定
Me.Caption = "印刷フォーム"
Label1.Caption = "日付リスト"
CommandButton1.Caption = "帳簿印刷"
CommandButton2.Caption = "帳票印刷"
CommandButton3.Caption = "請負印刷"
CommandButton4.Caption = "表紙印刷"
CommandButton5.Caption = "翌月更新"

Dim i As Long, j As Long, myItem, temp, myList()
Dim ws As Worksheet, r As Range

Set ws = Worksheets("入出金帳簿")

myItem = Application.WorksheetFunction.Transpose(ws.Range("L4:L24"))

i = 0
For Each r In ws.Range("B4", ws.Range("B" & Rows.Count).End(xlUp))
If InStr(1, Join(myItem, vbTab), r.Text) > 0 Then
If r.Text <> ws.Range("L5").Text Then
ReDim Preserve myList(i)
myList(i) = r.Offset(0, -1).Value
i = i + 1
End If
End If
Next r

For i = 0 To UBound(myList)
For j = UBound(myList) To i Step -1
If myList(i) > myList(j) Then
temp = myList(i)
myList(i) = myList(j)
myList(j) = temp
End If
Next j
Next i

With CreateObject("Scripting.Dictionary")
For i = 0 To UBound(myList)
.Item(myList(i)) = Empty
Next
ListBox1.List = .Keys
End With

End Sub






Private Sub CommandButton1_Click()
Dim tb As Control, flg As Boolean, Lrow As Long

flg = False

'入力や選択をチェック
For Each tb In Me.Controls

Select Case TypeName(tb)
Case "ListBox": flg = (tb.ListIndex = -1)
End Select

If flg Then
MsgBox "入力または選択を見直して下さい。", vbExclamation, "入力不備"
Exit Sub
End If

Next

'入力
With Worksheets("帳簿印刷")
.Activate
.Range("A1").Select
.Range("A1").Value = ListBox1.List(ListBox1.ListIndex, 0)
ActiveWindow.SelectedSheets.PrintOut From:=1, To:=1, Copies:=1

End With



End Sub

質問者が選んだベストソリューション

Yahoo!知恵袋 4399日前