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
