Hallo liebe Mitglieder,
vor ein paar Monaten wurde mir geholfen aus einer Excel-Datenbank (bzw. Liste), automatisch eine Rechnung zu generieren. In der Liste befinden sich Stammdaten wie Name, Rechnungsnummer, Kundennummer, Stunden, Stundensatz etc.
In einem weiteren Spreadsheet ist dann das Layout der Rechnung. Durch das folgende Makro wurden erfolgreich die Daten in das Layout kopiert.
Doch wie es im Leben so ist, ändern sich mit der Zeit einfach die Anforderungen. Ich hatte bislang pro Rechnung nur einen Posten aufgeführt. Somit war der Excel-gesteuerte Vorgang recht einfach (Kopiere von A nach B). In letzter Zeit kommen aber des öfteren immer die selben Posten dazu. Deshalb würde ich gerne das Makro erweitern. Mein erster Gedanke war dann, eine Userform mit Checkboxabfrage einzubauen. Die Userform kann z.B. 3 Checkboxen und 2 Command-buttons (OK u. Abbrechen) beinhalten.
Checkbox 1 steht für die Berechnung der Anreise
Checkbox 2 steht für die Berechnung der Abreise
Checkbox 3 steht für die Berechnung sonstiger Posten
Jetzt erst einmal der Code
Hier sieht man unten die verschiedenen "case" ich hab versucht durch die Ergänzung von kommentaren sichtbar zu machen was gerade passiert.
Ok jetzt zum Problem: Vom logischen und gestalterischen Ablauf her, muss die Berechnung der Anreise vor die eigentliche Leistung. Die Anreise an sich, ist aber variabel und nicht Teil von jeder Rechnung. Somit würde ja die Zeile mit der die Rechnung beginnt (also die Aufzählung der Posten) variieren. Bei dem Kopiervorgang der Zellen (unten) seht ihr dass der Ort an den die Information kopiert wird, klar definiert ist. Das macht es zum Problem wenn ich davor aber noch was "einschieben" will. Im prinzip will ich durch die Checkboxabfrage sagen: kopiere zwar immer noch in die selbe spalte, aber jetzt eben eine zeile darunter. Quasi als Rechnungsposten Nr.2. Posten Nr. 1 (durch die Checkboxangewählt) ist ja nun die Anreise und damit verbunden bedeutet es dass in den spalten C bis H immer die selben werte reinkommen.
Ich hoffe es ist nicht so verwirrened.
der Code steht in meiner userform:
Private Sub commandbutton1_click()
Call Unload(UserForm3)
Const w = 2
Const t1 = "Liste"
Const t2 = "Übersicht"
Dim w1 As Worksheet
Dim w2 As Worksheet
'Dim w3 As Worksheet
Dim s As String
Dim y1 As Long
Dim x1 As Long
Dim y2 As Long
Dim x2 As Long
Dim n As Long
Dim jn As Long
Set w1 = Worksheets("Kundendatenbank")
Set w2 = Worksheets("Rechnung")
' Set w3 = Worksheets("PDF Online Rechnung")
' Makrobeginn mit der Zeilenabfrage über die Inputbox
s = InputBox("Rechnungs - relevante ZEILE?", "RECHNUNG")
If (s <> "") Then 'es wurde nicht "abbruch" oder [x] angeklickt
Sheets("Kundendatenbank").Select
y1 = Val(s)
If (y1 > 0) Then 'es wurde ein gültiger zahlenwert eingegeben
jn = MsgBox("Soll alles kopiert werden?", vbOKCancel, "Kopieren?")
If (jn = vbOK) Then
'Unmerge
Worksheets("Rechnung").Select
Range("A9:B9").Select
Selection.UnMerge
Range("A10:C11").Select
Selection.UnMerge
' Ende Kopfbereich ANFANG KOPIEREN
' Ausgabe der Rechnung mit ANREISEKOSTEN
If CheckBox1 = True Then
' Kopiervorgang der einzelnen Zellen [X1,X2 --> Spalten // Y1,Y2 --> Zeilen]
' # = Variable Größe die sich ändert
For n = 1 To 3
Select Case n
Case 1: '#####Rechnungsdatum#####
x1 = 12: y2 = 17: x2 = 2
Case 2: ' #####Sonderposten#####
x1 = 17: y2 = 17: x2 = 6
' Case 10: ' Ersatz
'x1 = 14: y2 = 22: x2 = 6
Case Else: 'mehr "n" als "case"
x1 = 0
End Select
If (x1 > 0) Then
w1.Cells(y1, x1).Copy
w2.Cells(y2, x2).PasteSpecial Paste:=xlPasteValues
End If
Next n
w2.Activate
Else
MsgBox "Bitte Ganz genau die Zeile überprüfen!!!"
End If
'merge
Range("B18").Select
Unload Me
Else
If CheckBox1 = False Then
End If
End If
' ABREISEKOSTEN
If CheckBox2 = True Then
MsgBox ("2")
Else
If CheckBox2 = False Then
End If
End If
' SONDERKOSTEN "EXOTEN"
If CheckBox3 = True Then
' Kopiervorgang der einzelnen Zellen [X1,X2 --> Spalten // Y1,Y2 --> Zeilen]
' # = Variable Größe die sich ändert
For n = 1 To 3
Select Case n
Case 1: '#####Rechnungsdatum#####
x1 = 12: y2 = 23: x2 = 2
Case 2: ' #####Sonderposten#####
x1 = 17: y2 = 23: x2 = 6
' Case 10: ' Ersatz
'x1 = 14: y2 = 22: x2 = 6
Case Else: 'mehr "n" als "case"
x1 = 0
End Select
If (x1 > 0) Then
w1.Cells(y1, x1).Copy
w2.Cells(y2, x2).PasteSpecial Paste:=xlPasteValues
End If
Next n
w2.Activate
Else
MsgBox "Bitte Ganz genau die Zeile überprüfen!!!"
End If
'merge
Range("B18").Select
Unload Me
If CheckBox3 = False Then
End If
End If
'KEINE ZUSATZKOSTEN
'Standard
If CheckBox4 = True Then
'ABFRAGE VON OBEN ANFANGEN
' Kopiervorgang der einzelnen Zellen [X1,X2 --> Spalten // Y1,Y2 --> Zeilen]
' # = Variable Größe die sich ändert
For n = 1 To 10
Select Case n
Case 1: ' Adresse
x1 = 3: y2 = 10: x2 = 1
Case 2: ' Name
x1 = 2: y2 = 9: x2 = 1
Case 3: 'Rechnungsnummer Nummer
x1 = 11: y2 = 9: x2 = 6
Case 4: 'Kundennummer
x1 = 9: y2 = 10: x2 = 6
Case 5: ' Bezüglich
x1 = 10: y2 = 12: x2 = 6
Case 6: ' Gebohren
x1 = 4: y2 = 13: x2 = 6
Case 7: '#####Rechnungsdatum#####
x1 = 12: y2 = 19: x2 = 2
Case 8: ' #####Tage#####
x1 = 16: y2 = 19: x2 = 4
Case 9: ' #####Tagessatz#####
x1 = 15: y2 = 19: x2 = 5
' Case 10: ' Bezeichnung!!!
'x1 = 13: y2 = 19: x2 = 3
Case Else: 'mehr "n" als "case"
x1 = 0
End Select
If (x1 > 0) Then
w1.Cells(y1, x1).Copy
w2.Cells(y2, x2).PasteSpecial Paste:=xlPasteValues
End If
Next n
w2.Activate
Else
MsgBox "Bitte Ganz genau die Zeile überprüfen!!!"
End If
'merge
Worksheets("Rechnung").Select
Range("A9:B9").Select
Selection.Merge
Range("A10:C11").Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlTop
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
Range("B18").Select
Else
If CheckBox4 = False Then
End If
End If
Unload Me
End Sub
Private Sub UserForm_Initialize()
Dim ctrl As Control
For Each ctrl In Me.Controls
If Left(ctrl.Name, 6) = "CheckB" Then
ctrl.Value = False
End If
Next
End Sub
Private Sub commandbutton2_click()
Unload Me
End Sub
Menü
An- und Abmelden
Partner / Links
Beiträge anzeigen