Sub DruckRebbelroth()
On Error GoTo R_Error
Auswahl = MsgBox("Druck starten?", 3, "Rebbelroth")
If Auswahl = 6 Then
Dim newNr As Variant, oldNr As Variant
Dim FileName As String
FileName = "C:\Rechnung33.ini"
If Range("E19") <> "" Then Range("E19") = ""
If Range("E20") <> "" Then Range("E20") = ""
Close #1
restart:
Open FileName For Input As #1
Line Input #1, oldNr
Close #1
newNr = oldNr + 1
Open FileName For Output As #1
Write #1, newNr
Close #1
Select Case Len(newNr)
Case 1
newNr = "00" & newNr
Case 2
newNr = "0" & newNr
Case 3
newNr = newNr
Case 4
MsgBox "Zahlenlimit überschritten"
Exit Sub
End Select
Range("E19") = "Rech.Nr."
Range("E20") = "33." & newNr & "." & Format(Date, "YY")
GoTo Druckdoch
R_Exit:
Exit Sub
ElseIf Auswahl = 7 Then
gohop:
Dim Auswahl2 As Variant
Auswahl2 = InputBox("Welche Rechnungsnummer möchten Sie Drucken?", "Rebbelroth")
If Auswahl2 <> "" Then
Select Case Len(Auswahl2)
Case 1
Auswahl2 = "00" & Auswahl2
Case 2
Auswahl2 = "0" & Auswahl2
Case 3
Auswahl2 = Auswahl2
Case 4
MsgBox "Zahlenlimit überschritten"
GoTo gohop
End Select
Range("E19") = "Rech.Nr."
Range("E20") = "33." & Auswahl2 & "." & Format(Date, "YY")
GoTo Druckdoch
Else
Exit Sub
End If
Else
Exit Sub
End If
R_Error:
Select Case Err
Case 53
Open FileName For Output As #1
Close #1
Open FileName For Output As #1
Write #1, 0
Close #1
Err.Clear
Resume restart
Case 54
Close #1
Resume restart
Case Else
MsgBox Err & ": " & Err.Description
Resume R_Exit
End Select
Druckdoch:
ActiveWindow.SelectedSheets.PrintOut Copies:=1
ActiveSheet.Shapes.AddTextEffect(msoTextEffect1, "Kopie", "Arial Black", 36# _
, msoFalse, msoFalse, 226.5, 127.5).Select
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.Solid
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(192, 192, 192)
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Line.Weight = 0.5
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.ForeColor.RGB = RGB(0, 0, 0)
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
Selection.ShapeRange.IncrementRotation -29.67
Selection.ShapeRange.IncrementLeft -39#
Selection.ShapeRange.IncrementTop -95.25
ActiveWindow.SelectedSheets.PrintOut Copies:=1
Selection.Delete
End Sub
jetzt will ich, dass diese Tabelle gespeichert wird und zwar nach der rechnungsnummer auf D:/Geschäft/Offene Rechnungen
kann mir da jemand einen tipp geben? (ich kann mir die zeilen schon an den richtigen ort schieben den VB kann ich ganz gut nur leider kein VBA)
gruß marc