Ich habe eine "Schriftverkehrs Vorlage" erstellt, die mehrere Personen benutzen sollen.
Speichern unter geöffnetem Namen ist nicht möglich, da die Datei schreibgeschützt ist.
ich verwende folgenden Code von Ramses für die Erzeugung einer Nummer
Private Sub Workbook_Open()
'Sub Fortlaufende_RechnungsNummer()
'byRamses
'Das Makro in das Workbook_Open Ereignis einer Vorlage !!! kopieren
'um die automatische Nummern erstellung zu generieren.
'Beim speichern der Vorlage darf in der Zelle mit dem Namen "Rechnungsnummer"
'nichts stehen
'Ansonsten kann das Makro einer Schaltfläche zugwiesen werden.
'In der Zelle mit dem Namen "Rechnungsnummer" darf nichts stehen !!
'beim ausführen bzw. Start des Makros
On Error GoTo R_Error
Dim newNr As Variant, oldNr As Variant
Dim FileName As String
FileName = "G:\1001 JEDERMANN\NUMMER.ini"
'Prüfen ob bereits eine Rechnungsnummer in der Zelle steht
'Um ein erneutes hochzählen bei späterem öffnen der Datei zu vermeiden
If Range("NUMMER") "" Then Exit Sub
'Erstellen einer externen Datei zum dokumentieren der
'fortlaufenden 5 stelligen Nummer
Close #1
'Öffnen der INI Datei
restart:
'Pfad der Datei bitte in der Deklaration anpassen
Open FileName For Input As #1
'einlesen der alten Nummer
Line Input #1, oldNr
Close #1
'Berechnen und schreiben der neuen Nummer
newNr = oldNr + 1
Open FileName For Output As #1
Write #1, newNr
'Schliessen der INI Datei
Close #1
'Länge der Zahl bestimmen
Select Case Len(newNr)
Case 1
newNr = "0000" & newNr
Case 2
newNr = "000" & newNr
Case 3
newNr = "00" & newNr
Case 4
newNr = "0" & newNr
Case 5
newNr = newNr
Case 6
MsgBox "Zahlenlimit überschritten"
Exit Sub
End Select
'Rechnungsnummer ist ein Name der sich auch eine Zelle bezieht
'Achtung:: Es dürfen keine Doppelpunkte, Slash oder Backslash verwendet werden
'Range("NUMMER") = "" & Format(Now, "yyyy") & "-" & newNr
Range("NUMMER") = "" & Left(ActiveSheet.Range("B2"), 3) & "-" & Right(Year(Date), 2) & "-" & _
newNr & "-" & ActiveSheet.Range("L7")
R_Exit:
Exit Sub
R_Error:
Select Case Err
Case 53
'Datei ist noch nicht vorhanden
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
'Datei ist bereits geöffnet und wurde noch nicht wieder geschlossen
Close #1
Resume restart
Case Else
MsgBox Err & ": " & Err.Description
Resume R_Exit
End Select
End Sub
Mein Problem ist folgendes:
Der Speicherpfad der ini. Datei in dem die letzte vergebene Nummer gespeichert ist liegt ja jetzt bei mir in folgendem Pfad:
FileName = "G:\1001 JEDERMANN\NUMMER.ini"
Gibt es ne Möglichkeit z. B. per UF den Speicherpfad zu ändern, also nicht das in dem Quellcode direkt geändert wird, weil das traue ich den meisten, die es benutzen nicht zu.
Das gleiche Problem habe ich auch an anderer Stelle und zwar, kann ja nur unter vorgegebenen Namen abgespeichert werden mit diesem Code
Sub Speichern()
Dim Ergebnis
Dim XWN As String
AKTIVVER = "D:\Excel\Schriftverkehr\"
XW1 = Sheets("Tabelle1").Range("NUMMER").Value
XWN = AKTIVVER & XW1
Ergebnis = Application.GetSaveAsFilename(InitialFileName:=XWN, fileFilter:="Microsoft Excel-Arbeitsmappe (*.xls),*.xls")
If Ergebnis False Then
'Datei speichern
ActiveWorkbook.SaveAs FileName:=Ergebnis, FileFormat:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
End If
End Sub
Auch hier wäre es klasse den Speicherpfad per VBA zu ändern.
Gibt es hierfür Möglichkeiten?
Ganz genial wäre ja, das sich die UF beim ersten Mal selbst öffnet (Workbook Open), um alles einstellen zu können und dann nur noch per Commandbutton aufrufbar ist....
LG Gerhard