Rechnung erstellen und Funktionen automatisieren.

Hallo.
Habe ein Problem mit der Automatisierung meiner Rechnungstabelle.
Worum es geht:
- Habe eine Vorlage (.xlt) für eine Rechnung erstellt.
- Datum und Teile der Rechnungsnummer ("XXX"-2009) werden automatisch erstellt.
- "Bezeichnungseingabe" der abzurechnenden Dienstleistungen werden per DropDown ausgewählt. Dadurch wird direkt der Einzelpreis ermittelt und die dafür vorgesehene Spalte geschrieben. Anzahl (z.B. der Stunden) sind händig einzugeben und der Gesamtpositionspreis wird dann wieder automatisch errechnet. Berechnungen hab ich alle soweit im Griff.
Aber jetzt kommst:
Brauche noch drei Funktionen.
Automatisches Speichern der Datei mit automatischer Vergabe des Dateinamens (zum Teil schon über VB erledigt durch auslesen der automatisch erstellten Bestellnummer). Nun soll aber zu der nummerischen Speicherung der Rechnung (.xls) auch gleichzeitig die .xlt aktualisiert und gespeichert werden werden, aber ohne die Positionen und Preise aus der abgespeicherten Rechnung (muß diese sonst jedes Mal händig löschen.
Ziel:
Rechnungsvorlage öffnen - Rechnung schreiben - automatisch speichern der Rechnung und gleichzeitig die Vorlage mit aktualisierter Bestellnummer aber ohne Dienstleistungbeschreibung und Preise speichern.
Falls die Beschreibung zu allgemein ist, kann ich auch gerne die Datei hochladen.
Muß nur noch sehen wo ich das machen kann, da ich mich gerade erst angemeldet hab.
Allen schon mal Danke im Voraus!!!
P.S.: Rechnung soll noch weiter automatisiert werden, z.B. wenn letzte Beschreibungszeile der Dienstleistung voll ist, automatisch eine neue Zeile anfügen.
Bei mehreren Seiten automatischer Übertrag der Zwischensumme und beim speichern der Vorlage Zeilen wieder auf Ursprungsanzahl setzen.
Denke aber sollte zuerst mal das eine Prob lösen.-)

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Hier der Code:
Wobei ' ###### Automatisch Zeilen einfügen und Formeln, Formate etc. übernehmen ### NICHT funktioniert!
Option Explicit
' ###### Schreibschutz für Makros deaktivieren und RechnungsZähler beim Öffnen der Datei erhöhen! ###

Private Sub Workbook_Open()
' ###### heb den Schreibschutz manuell auf und setze ihn dann per Makro nach folgendem Muster: # _
' ###### Durch den Parameter UserInterfaceOnly gilt der Blattschutz nur für manuelle Eingaben,  _
nicht aber für Makros. ###
Worksheets("Rechnung für Dienstleistungen").Protect UserInterfaceOnly:=True
' ###### ENDE "heb den Schreibschutz manuell auf und setze ihn dann per Makro nach folgendem  _
Muster:"! ###
' ###### in der folgenden Zeilen wird der RechnungsZähler beim Öffnen der Datei erhöht werden! # _
ActiveSheet.Range("F6") = ActiveSheet.Range("F6") + 1
End Sub

' ###### ENDE "der RechnungsZähler wird beim Öffnen der Datei erhöht"! ###
' ###### Automatisch Zeilen einfügen und Formeln, Formate etc. übernehmen ###

Private Sub Worksheet_Change(ByVal Target As Range)
If Cells(Cells(Rows.Count, 1).End(xlUp).Row, 1).Address = Target.Address Then
With Application
.ScreenUpdating = False
Range(Cells(Target.Row, 1), Cells(Target.Row, 5)).Copy
Cells(Target.Row + 1, 1).PasteSpecial Paste:=xlPasteFormulasAndNumberFormats
ActiveCell.ClearContents
.GoTo ActiveCell.Offset(-1, 0)
.ScreenUpdating = True
Application.CutCopyMode = False
End With
End If
End Sub

' ###### ENDE "Automatisch Zeilen einfügen und Formeln, Formate etc. übernehmen"! ###
' ###### in den folgenden Zeilen wird die AutoSave-Funktion gesetzt mit fortlaufendem Dateiname! ###

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim aw
If ThisWorkbook.Saved Then Exit Sub
aw = MsgBox("Änderungen speichern?", vbYesNoCancel)
Select Case aw
Case vbYes: SpeichernUnter
Case vbNo: ThisWorkbook.Saved = True
Case vbCancel: Cancel = True
End Select
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If SaveAsUI Then MsgBox "Dateiauswahl deaktiviert! Dateiname wird automatisch vergeben.  _
Speicherort: D:\Rechnung_XXX-2009!"
Cancel = True
SpeichernUnter
End Sub

Private Sub SpeichernUnter()
Dim fn As String
' ###### Dateiname ermitteln und prüfen: ###
fn = Worksheets("Rechnung für Dienstleistungen").Range("D6")
If Trim(fn) = "" Or _
InStr(fn, ".") > 0 Or _
InStr(fn, "\") > 0 Or _
InStr(fn, "/") > 0 Or _
InStr(fn, " 0 Or _
InStr(fn, ">") > 0 Or _
InStr(fn, "[") > 0 Or _
InStr(fn, "]") > 0 Or _
InStr(fn, ":") > 0 Or _
InStr(fn, "|") > 0 Or _
InStr(fn, "*") > 0 Or _
InStr(fn, "?") > 0 Then
MsgBox "Unzulässiger Dateiname!" & vbLf & "Datei wurde nicht gespeichert!", vbCritical
Exit Sub
End If
Application.EnableEvents = False
Application.DisplayAlerts = True
On Error Resume Next
' ###### in der folgenden Zeile wird der Dateiname und Speicherort bestimmt (Rechnung für  _
Dienstleistungen!D6)! ###
ThisWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & "Rechnung_" & fn & ".xls"
If Err.Number > 0 Then MsgBox Err.Description, vbCritical, "Fehler " & Err.Number
On Error GoTo 0
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub

' ###### ENDE "wird die AutoSave-Funktion gesetzt mit automatischem Dateiname"! ###
P.S.: Wie und wo kann ich denn die Datei hochladen, falls nötig und gewünscht?

Beliebteste Forumthreads (12 Monate)

Rechnung erstellen und Funktionen automatisieren.

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

63 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Rechnung erstellen und Funktionen automatisieren.

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

63 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread