AW: ListBox Eintrag
22.11.2019 21:09:58
Nepumuk
Hallo JoHa,
teste mal:
Private Sub CommandButton1_Click()
Dim C As Range, X&, N&, LastRow&, PrintString$
Dim avntValues() As Variant
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
ListBox1.Clear 'Listboxeinträge löschen
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
StartDatum = ComboBox1 'Stardatum als String speichern
End__Datum = ComboBox2 'Enddatum als String speichern
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
On Error GoTo ErrExit
If CDate(StartDatum) <= CDate(End__Datum) Then
Caption = " b i t t e w a r t e n . . ."
With Tabelle2
LastRow = .Range("A2").End(xlDown).Row
'Startdatum ermitteln -> Zelladresse als String in Variable(StartDatum) schreiben
For Each C In .Range("A2:A" & LastRow)
If C.Value = CDate(StartDatum) Then StartDatum = C.Address: Exit For
Next
'Enddatum ermitteln -> Zelladresse als String in Variable(End__Datum) schreiben
For Each C In .Range("A" & Range(StartDatum).Row & ":A" & LastRow)
If C.Value = CDate(End__Datum) Then End__Datum = C.Address: Exit For
Next
For X = Range(StartDatum).Row To Range(End__Datum).Row
Redim Preserve avntValues(10, N)
avntValues(0, N) = .Cells(X, 1).Value
avntValues(1, N) = .Cells(X, 2).Value
avntValues(2, N) = .Cells(X, 3).Value
avntValues(3, N) = .Cells(X, 4).Value
avntValues(4, N) = .Cells(X, 5).Value
avntValues(5, N) = .Cells(X, 6).Value
avntValues(6, N) = .Cells(X, 7).Value
avntValues(7, N) = .Cells(X, 8).Value
avntValues(8, N) = .Cells(X, 9).Value
avntValues(9, N) = .Cells(X, 10).Value
avntValues(10, N) = .Cells(X, 11).Value
N = N + 1
Next
ListBox1.Column = avntValues
PrintString = "A" & Range(StartDatum).Row & ":j" & Range(End__Datum).Row
Tabelle3.Range("A3:j65536").ClearContents
.Range(PrintString).Copy
Tabelle3.Range("A3").PasteSpecial xlValue
Application.CutCopyMode = False
Tabelle3.PageSetup.PrintArea = "A1:D" & Tabelle3.Range("A3").End(xlDown).Row
MsgBox "Der neue Druckbereich wurde festgelegt in der Tabelle(Druck) auf: " & "A1:j" & Tabelle3.Range("A3").End(xlDown).Row
End With
Caption = "Kalender 2020"
Else
MsgBox "Startdatum muß kleiner Enddatum sein", vbInformation, "keine Aktion"
End If
Exit Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
ErrExit:
MsgBox "beide Eingaben müssen ein gültiges und vorhandenes Datum sein!", vbCritical, "Abbruch"
End Sub
Gruß
Nepumuk