Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
448to452
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
448to452
448to452
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Probleme mit meinem Makro

Probleme mit meinem Makro
04.07.2004 12:32:25
Marc
bei diesem Makro habe ich das Problem, dass eimne File mit dem richtigen Namen an der richtigen stelle gespeichert wird, aber keine daten enthält. wo könnte da der fehler liegen ?

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

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Das funktioniert doch!
04.07.2004 13:16:00
Hans
Hallo End Sub
Bei mir funktioniert dein Makro. Allerdings musst du die Variable Auswahl6 deklarieren, und in der Ini-Datei muss ein Zahlenwert stehen. Diese Vorgabe kannst du umgehen, indem du nach der Zeile "Line Input #1, oldNr" die Zeile "If oldNr = Empty Then oldNr = 0" einfügst.
Gruss
Hans T.
funktioniert
04.07.2004 14:52:37
marc
habe noch ein bischen mit ActiveWorkbook ThisWorkbook geändert und nun geht's. Danke nochmal
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige