Probleme mit meinem Makro
04.07.2004 12:32:25
Marc
Sub DruckDerschlag()
On Error GoTo R_Error
auswahl6 = MsgBox("Druck starten?", 3, "Derschlag")
If auswahl6 = 6 Then
Dim newNr As Variant, oldNr As Variant, nam As Variant
Dim FileName As String
FileName = "C:\Rechnung80.ini"
nam = ThisWorkbook.Name
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") = "80." & newNr & "." & Format(Date, "YY")
If Right(nam, 3) = "xls" Then nam = Left(nam, Len(nam) - 4)
ThisWorkbook.SaveAs "D:/Geschäft/Offene Rechnungen/" & "80." & newNr & "." & Format(Date, "YY") & " " & ActiveWorkbook.Name & " " & Format(Date, "YY.MM.DD") & ".xls"
GoTo Druckdoch
R_Exit:
Exit Sub
ElseIf auswahl6 = 7 Then
Dim Auswahl7 As Variant
gohop:
Auswahl7 = InputBox("Welche Rechnungsnummer möchten Sie Drucken?", "Derschlag")
If Auswahl7 <> "" Then
Select Case Len(Auswahl7)
Case 1
Auswahl7 = "00" & Auswahl7
Case 2
Auswahl7 = "0" & Auswahl7
Case 3
Auswahl7 = Auswahl7
Case 4
MsgBox "Zahlenlimit überschritten"
GoTo gohop
End Select
Range("E19") = "Rech.Nr."
Range("E20") = "80." & Auswahl7 & "." & Format(Date, "YY")
If Right(nam, 3) = "xls" Then nam = Left(nam, Len(nam) - 4)
ThisWorkbook.SaveAs "D:/Geschäft/Offene Rechnungen/" & "80." & Auswahl7 & "." & Format(Date, "YY") & " " & ActiveWorkbook.Name & " " & Format(Date, "YY.MM.DD") & ".xls"
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