Private Sub Cmd_Clear_Click()
Dim k As Long
Me.ListBox1.Clear
For k = 1 To 13
Me.Controls("a" & k) = vbNullString
Next
End Sub
'++++++++++++++++++++++++++++++++++++++++++
Private Sub To_sheet_Click()
Dim k As Long, lr As Long
lr = ActiveSheet.Cells(Rows.Count, 1).End(3).Row + 1
If lr = 1 Then lr = 2
For k = 1 To 13
ActiveSheet.Cells(lr, k) = Me.Controls("a" & k)
Next
With Me.ListBox1
If .ListCount = 0 Then
FirstRow
Else
NextRow
End If
End With
End Sub
'+++++++++++++++++++++++++++++++++
Private Sub FirstRow()
Dim arr() As Variant
Dim i As Long
With Me.ListBox1
ReDim arr(1 To 1, 1 To .ColumnCount)
For i = LBound(arr, 2) To UBound(arr, 2)
arr(1, i) = Me.Controls("a" & i).Value
Next i
.List = arr()
End With
End Sub
'""""""""""""""""""""""""""""""""
Private Sub NextRow()
Dim arr() As Variant
Dim i As Long
With Me.ListBox1
arr() = Application.Transpose(.List())
ReDim Preserve arr(1 To UBound(arr, 1), 1 To UBound(arr, 2) + 1)
For i = LBound(arr, 1) To UBound(arr, 1)
arr(i, UBound(arr, 2)) = Me.Controls("a" & i).Value
Next i
.List = Application.Transpose(arr())
End With
End Sub
تحميل محتوى الموضوع
عرض نسخة صالحة للطباعة
أرسل هذا الموضوع إلى صديق
