Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1492to1496
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Druckbereiche (Anfangs-und Enddatum)

Druckbereiche (Anfangs-und Enddatum)
17.05.2016 13:39:36
Michael
Hallo Zusammen,
da mir in der Vergangenheit im Forum sehr gut geholfen wurde, benötige ich noch
einmal Hilfe. Ich habe 2 TextBoxen auf einer UserForm, indem man das Anfangs-(TextBox1) und das Enddatum (TextBox2) eingeben kann. Auf einem CommandButton wird dann der unten aufgeführte Code ausgelöst. Nun das Problem:
Nach dem sortieren des Tabellenblattes nach Datum, sollte er mir dann den Bereich der Daten anzeigen, den ich durch die Datumsangaben eingegrenzt habe. Mein Code findet entweder das Anfangsdatum oder auch manchmal das Enddatum nicht, obwohl die Daten vorhanden sind. Es erscheinen dann, die MSG Boxen. Als Hinweis: die Zellen werden umgewandelt in Datumsangaben, wegen der TextBoxen, trotzdem klappt es nicht.
Irgendeine IDEE. Bin offen für alles.
Gruß Michael
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!", vbOKOnly, ""
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!", vbOKOnly, ""
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
.PrintPreview
Unload Me
Else
MsgBox "Anfangsdatum nicht gefunden!", vbOKOnly, ""
End If
End If
Else
MsgBox "Enddatum nicht gefunden!", vbOKOnly, ""
End If
End If
Else
MsgBox "Anfangsdatum ungültig!", vbOKOnly, ""
End If
Else
MsgBox "Enddatum ungültig!", vbOKOnly, ""
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

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Druckbereiche (Anfangs-und Enddatum)
19.05.2016 05:55:01
fcs
Hallo Michael,
daurch, dass du falschen Eingaben/nicht gefundenen Datumswerten das Userform8 aus dem Code des Userforms erneut per Show-Anweisung anzeigst kommt es zu einer Verschachtelung, so dass die Msgboxen ggf. nochmals angezeigt werden.
Mache im Code zuerst alle Prüfungen für die eingegebenen Datumswerte. Das funktioniert auch ohne das Blatt "Rechnungen" erst zu kopieren und zu sortieren. Bei fehlerhaften Eingaben wird dann nur das Makro verlassen ohne das Userform auszublenden und neu zu starten.
Gruß
Franz
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
'Eingaben prüfen
If Not IsDate(TextBox1) Then
MsgBox "Anfangsdatum ungültige Eingabe!", vbOKOnly, ""
Exit Sub
End If
If Not IsDate(TextBox2) Then
MsgBox "Enddatum ungültige Eingabe!", vbOKOnly, ""
Exit Sub
End If
With Sheets("Rechnungen")
temp = Application.WorksheetFunction.CountIf(.Columns(2), CLng(CDate(TextBox1)))
If temp = 0 Then
MsgBox "Das Anfangsdatum wurde nicht gefunden!", vbOKOnly, ""
TextBox1 = ""
Exit Sub
End If
temp = Application.WorksheetFunction.CountIf(.Columns(2), CLng(CDate(TextBox2)))
If temp = 0 Then
MsgBox "Das Enddatum wurde nicht gefunden!", vbOKOnly, ""
TextBox2 = ""
Exit Sub
End If
'Rechnungen kopieren, sortieren und drucken
'Application.ActivePrinter = "PDFCreator auf Ne00:"
Application.ActivePrinter = "FreePDF auf Ne10:"
.Visible = xlSheetVisible
.Copy After:=Sheets(Sheets.Count)
Set objWs = Sheets(Sheets.Count)
Range("B6").Select
End With 'Sheets("Rechnungen")
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
lngStart = Application.Match(CLng(CDate(TextBox1)), .Columns(2), 0)
lngEnd = Application.Match(CLng(CDate(TextBox2)), .Columns(2), 1)
Me.Hide
.PageSetup.PrintArea = CStr("A" & lngStart & ":I" & lngEnd)
'.PrintPreview
.PrintPreview
Unload Me
Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True
End With 'objWs
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 Sub

Anzeige
AW: Druckbereiche (Anfangs-und Enddatum)
19.05.2016 10:58:39
Michael
Hallo Franz,
erst einmal vielen Dank für deine Bemühungen. Soviel Zeit muss sein. Dein Code ist schon bemerkenswert, wäre mir so nicht in den Sinn gekommen. Ich habe den Code mal laufen lassen und jetzt zeigt er mit richtigerweise das Anfangsdatum an (04.01.2016) ohne MSGBOX. Beim Enddatum allerdings, findet er den (30.03.2016) nicht, obwohl, wie gesagt, dieses Datum vorhanden ist, dann kommt auch die MSGBOX. Nach mehrmaligen ändern des Enddatums auf: (29.03.2013, 28.03.2016, 27.03.2016) erscheint immer die MSGBOX. Was mir aber auffällt ist, dass wenn ich das gleiche Enddatum nehme, wie beim Anfangsdatum, es wunderbar funktioniert. IDEE? an der Formatierung kann es doch nicht liegen, oder?
Gruß Michael

Anzeige
AW: Druckbereiche (Anfangs-und Enddatum)
19.05.2016 11:37:34
fcs
Hallo Michael,
ich hatte mir die Mühe gemacht eine kleine Testdatei zu Basteln und da funktionierte es für beide Datumswerte und es wurde per FreePDF ein entsprechendes PDF erzeugt.
Die Datumszellen in Spalte B ab Zeile 6 hatte ich manuell eingegeben und und die Standard-Formatierung für das Datum verwendet, so dass in der Deutschen Version das Datum als TT.MM.JJJJ dargestellt ist.
Ich sehe im Moment 2 Möglichkeiten für das Problem:
a) Du verwendest ein spezielles Datumsformat, bei dem die Funktion "CountIf" probleme mit der Auswertung hat.
Lösung: Datumsformat in Spalte B auf das Standard-Datumsformat ändern.
b) Die Datumswerte stehen teilweise doch noch als Text in den Zellen
Lösung: Die Zellen mit den Datumswerten markieren und das folgende Makro starten.
Sub Text_to_Datum()
'ändert im selektierten Zellbereich Datum-Text in Datumswerte
Dim Zelle As Range
Dim StatusCalc As Long
With Application
.ScreenUpdating = False
StatusCalc = .Calculation
.Calculation = xlCalculationManual
End With
Selection.NumberFormat = "m/d/yyyy"
For Each Zelle In Selection.Cells
If IsDate(Zelle.Text) Then
Zelle.Value = CDate(Zelle.Text)
End If
Next
With Application
.ScreenUpdating = True
.Calculation = StatusCalc
End With
End Sub

Das Datums-Format kannst du anscließen nach deinen Vorstellungen einstellen.
Gruß
Franz

Anzeige
AW: Druckbereiche (Anfangs-und Enddatum)
19.05.2016 14:18:04
Michael
Hallo Franz,
ich kann nur sagen........Hammer.....Hammmer......Hammer. Ich habe ein Datum verwendet, dass mir als benutzerdefiniert so angezeigt (*04.01.2016) wurde. Habe anschließend die Lösung a.) ausprobiert (die Zellen markiert und Formatierung geändert).Dachte es klappt....ging aber trotzdem nicht.
Dann habe ich dein Makro verwendet und klick.....einwandfrei.....endlich funktioniert es genausso, wie ich es mir erträumt habe. Das hätte ich im Leben nicht hinbekommen. Ich muß wirklich irgendwie einen Fehler gehabt haben. Ohne deine Hilfe wäre ich echt nicht weitergekommen.
Hut ab....kann mich nur wiederholen...Hammer....Hammer....Hammer....Danke....Danke....Danke
Gruß Michael
und ein baldiges, schönes Wochenende
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige