AW: TextBox Datum
01.02.2016 11:45:02
Michael
Kannst du damit was anfangen?
Die Datei ist sehr groß und scheitert an der 1Mbyte Grenze.
Gruß MM
Private Sub CommandButton3_Click()
Dim objWs As Worksheet
Dim varRet As Variant, lngStart As Long, lngEnd As Long
Dim temp
Dim i As Long
Dim zeile As Long
Dim ende As Long
Application.ActivePrinter = "PDFCreator auf Ne00:"
With Sheets("Rechnungen")
.Visible = xlSheetVisible
.Copy After:=Sheets(Sheets.Count)
Set objWs = Sheets(Sheets.Count)
Range("B6").Select
With objWs
.Unprotect
Range("A6:I65535").Select
Selection.Sort Key1:=Range("B6"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortTextAsNumbers
Range("B6").Select
If IsDate(TextBox1) Then
If IsDate(TextBox2) Then
temp = Application.WorksheetFunction.CountIf(.Columns(2), CLng(CDate(TextBox1)))
If temp = 0 Then
MsgBox "Das Anfangsdatum wurde nicht gefunden!"
TextBox1 = ""
ActiveSheet.Unprotect
Application.DisplayAlerts = False
.Delete
UserForm8.Hide
UserForm8.Show
End
Else
varRet = Application.Match(CLng(CDate(TextBox1)), .Columns(2), 0)
If IsNumeric(varRet) Then
lngStart = varRet
temp = Application.WorksheetFunction.CountIf(.Columns(2), CLng(CDate(TextBox2)))
If temp = 0 Then
MsgBox "Das Enddatum wurde nicht gefunden!"
TextBox2 = ""
ActiveSheet.Unprotect
Application.DisplayAlerts = False
.Delete
UserForm8.Hide
UserForm8.Show
End
Else
varRet = Application.Match(CLng(CDate(TextBox2)), .Columns(2), 1)
If IsNumeric(varRet) Then
lngEnd = varRet
Me.Hide
.PageSetup.PrintArea = CStr("A" & lngStart & ":I" & lngEnd)
'.PrintPreview
.PrintOut Copies:=1, Collate:=True
Unload Me
Else
MsgBox "Anfangsdatum nicht gefunden!", vbInformation
End If
End If
Else
MsgBox "Enddatum nicht gefunden!", vbInformation
End If
End If
Else
MsgBox "Anfangsdatum ungültig!", vbInformation
End If
Else
MsgBox "Enddatum ungültig!", vbInformation
End If
Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True
End With
With Sheets("Schnellstart")
.Visible = True
.Activate
End With
For Each objWs In ThisWorkbook.Worksheets
If Not objWs.Name = "Schnellstart" Then
objWs.Visible = xlVeryHidden
End If
Next
End With
End Sub