AW: Brauche Hilfe
20.01.2016 07:27:15
Michael
Hallo Matthias,
erst einmal vielen Dank für deine Geduld. Ich werde versuchen, den Ablauf zu erklären und die passenden Makros mitzuschicken.
1. Auf einer Userform mit verschiedenen TextBoxen, werden die Daten in eine Tabelle übergeben. Anschließend produziert er aufgrund einer Formel auf dem Tabellenblatt (Spalte A) eine fortlaufende Nummer/ wird auch über ein CommandButton in einer TextBox angezeigt. Als Kriterium nimmt er hier die Spalte C (verschiedene Rechnungsnummern).
Code auf CommandButton/UserForm1:
Private Sub CommandButton1_Click()
Sheets("Rechnungen").Visible = True
Sheets("Rechnungen").Select
ActiveSheet.Unprotect
Range("C6").Select
Cells(Cells(Rows.Count, "B").End(xlUp).Row + 1, "B").Value = TextBox1
TextBox1 = "" 'leert die textbox
Cells(Cells(Rows.Count, "C").End(xlUp).Row + 1, "C").Value = TextBox2
TextBox2 = "" 'leert die textbox
Cells(Cells(Rows.Count, "E").End(xlUp).Row + 1, "E").Value = TextBox3
TextBox3 = "" 'leert die textbox
Cells(Cells(Rows.Count, "G").End(xlUp).Row + 1, "G").Value = TextBox4
TextBox4 = "" 'leert die textbox
Cells(Cells(Rows.Count, "H").End(xlUp).Row + 1, "H").Value = TextBox5
TextBox5 = "" 'leert die textbox
Dim MaxDatenZeile As Integer, SuchSpalte As Integer
SuchSpalte = 1
MaxDatenZeile = ActiveSheet.Cells(Rows.Count, SuchSpalte).End(xlUp).Row ' Muster - _
Datenzeile ermitteln.
MaxDatenZeile = MaxDatenZeile - 1 ' (Minus 1 ist Letzte Leere Dateneingabezeile)
If Range("B" & (MaxDatenZeile)) > "" And Range("B" & (MaxDatenZeile) + 1) = "" Then
On Error Resume Next
MaxDatenZeile = MaxDatenZeile + 1 ' Then von oben ausführen
With Rows((MaxDatenZeile) & ":" & (MaxDatenZeile)) ' Letzte Leere Dateneingabezeile mit _
Formatierung Auswählen und Kopieren
.Copy ' Fügt die Kopierte Zeile in das Arbeitsblatt ein und verschiebt _
die Musterzeile nach unten,
.Insert Shift:=xlDown ' so paßen sich die Formel Automatisch an.
End With
On Error Resume Next
ActiveSheet.Protect "", DrawingObjects:=True, Contents:=True, Scenarios:=True ' _
Blattschutz setzen
Else
End If
ActiveSheet.Protect
UserForm2.Show
UserForm1.Hide
End Sub
2. Auf dem nächsten UserForm2 kann ich mittels der produzierten, laufenden Nummer, die Rechnung
wieder einlesen. Angezeigt wird das Ergebnis in einer ListBox. Nach anklicken der Anzeige auf der ListBox,
werden alle Daten in Textboxen wiedergegeben und ermöglichen mir, Änderungen nachträglich vorzunehmen.
Dort habe ich auch die Möglichkeit, das Datum der Bezahlung (Spalte I) einzugeben. Anschließend wird
durch ein CommandButton alles wieder an die Tabelle übergeben.
Code UserForm2/Anzeigen der laufenden Nummer:
Load UserForm2
Sheets("Rechnungen").Visible = True
Dim letzteZeile As Long
letzteZeile = Cells(Rows.Count, 2).End(xlUp).Row
With TextBox1
.Value = Cells(letzteZeile, 1).Value
.SetFocus
.SelStart = 0
.SelLength = Len(.Text)
End With
Sheets("Rechnungen").Visible = False
Code UserForm3 / Übergabe an die Tabelle
Dim manipulierte_Zeile As Integer
With Sheets("Rechnungen")
.Visible = True
.Select
.Unprotect
If TextBox2.Tag = "" Then Exit Sub
manipulierte_Zeile = CLng(TextBox2.Tag)
.Cells(manipulierte_Zeile, 2) = Format(TextBox1, "DD.MM.YYYY")
.Cells(manipulierte_Zeile, 3) = Format(TextBox3.Text)
.Cells(manipulierte_Zeile, 5) = Format(TextBox4.Text)
.Cells(manipulierte_Zeile, 7) = Format(TextBox5.Text)
.Cells(manipulierte_Zeile, 8) = Format(TextBox6.Text)
.Cells(manipulierte_Zeile, 9) = Format(TextBox7, "DD.MM.YYYY")
.Protect
.Visible = False
End With
TextBox2.Tag = ""
Unload Me
With Me.ListBox1
If .ListIndex > -1 Then .RemoveItem (.ListIndex)
End With
UserForm7.Show
UserForm3.Hide
End Sub
3. Eine Sicherung kann ich auch erstellen. Die Makros liegen hierbei auf einem CommandButton. Dort
wird aber nicht nach dem Kriterium Datum (Spalte B) auf dem Tabellenblatt sortiert, sondern nach der
Spalte C (Rechnungsnummer). Das klappt tadellos.
Code für die Sicherung auf dem CommandButton
Sheets("Rechnungen").Visible = True
Sheets("Rechnungen").Select
ActiveSheet.Unprotect
Sheets("Rechnungen").Copy After:=Sheets(5)
Sheets("Rechnungen (2)").Select
Sheets("Rechnungen (2)").Name = "Sicherung der Rechnungen"
ActiveSheet.Range("A6:I65535").Select
Selection.Sort Key1:=ActiveSheet.Range("C6"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Application.ActivePrinter = "PDFCreator auf Ne00:"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Application.DisplayAlerts = False
Sheets(Array("Sicherung der Rechnungen")).Delete
Application.DisplayAlerts = True
ActiveSheet.Protect
Sheets("Schnellstart").Visible = True
Sheets("Schnellstart").Select
ActiveSheet.Protect
Sheets("Rechnungen").Visible = False
UserForm6.Hide
For Each wks In ThisWorkbook.Worksheets
If Not wks.Name = "Schnellstart" Then
wks.Visible = xlVeryHidden
End If
Next wks
End Sub
4. Jetzt will ich natürlich nicht immer eine komplette Sicherung sondern wollte mir die Jahresbezogen
oder Datumsbezogen anzeigen lassen (z.B. 01.01.2015 - 31.12.2015) oder auch ( z.B.10.10.2015 - 31.12.2015). Dies sollte eben über die zwei TextBoxen passieren, indem ich dort das Anfangs und das
Enddatum eintragen kann und er anschließend über ein CommandButton alles sortiert (Spalte B, im Tabellenblatt) und anzeigt. Und das ist eben der Knackpunkt.
Code mit der Sortierung und Anzeige (kennst du ja bereits)
Private Sub CommandButton1_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
ende = Range("B65536").End(xlUp).Row
Do Until i = ende
If ActiveCell.Value = "" Then
ActiveCell.EntireRow.Delete
Else
ActiveCell.Offset(1, 0).Select
End If
i = i + 1
Loop
.Visible = xlSheetVeryHidden
End With
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(3), CLng(CDate(TextBox1)))
If temp = 0 Then
MsgBox "Das Datum wurde nicht gefunden!"
End
Else
varRet = Application.Match(CLng(CDate(TextBox1)), .Columns(3), 0)
If IsNumeric(varRet) Then
lngStart = varRet
temp = Application.WorksheetFunction.CountIf(.Columns(3), CLng(CDate(TextBox2)))
If temp = 0 Then
MsgBox "Das Datum wurde nicht gefunden!"
End
Else
varRet = Application.Match(CLng(CDate(TextBox2)), .Columns(3), 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 "Eingabe im Datumsfeld >1212
Habe deinen Link mir angeschaut und das ist wirklich dieselbe Thematik. Aber ich erkenn meinen
Fehler nicht.
Gruß MM