Office: (Office 2013) Rechungen mit VBA erstellen und als PDF speichern.

dimah · 6. März 2018

Hallo Leute,
da ich ein VBA Neuling bin entschuldige mich für die Fehler und bitte um eure Hilfe.
Des Weiteren ist mein Deutsch nicht so Gut und bitte ich auch zu entschuldigen.
Habe mir den Code von vielen stellen zusammengesucht.

Ich habe eine Excel-Mappe erstellt, mit der ich meine Rechnungen erstellen möchte. Diese soll nur die Werte, Rahmen und Layout der Tabelle der Rechnungstabelle in einer neu erstellten Tabelle mit dem Rechnungsnamen (bestehen aus Daten, die sich aus der Rechnungstabelle ergeben) übertragen. Die Datei soll als Excel und pdf in einem neuen Ordner mit dem Namen des Rechnungsmonates gespeichert werden. Anschließend soll wieder das Sheet Rechnungstabelle aktiv sein, damit ich die nächste Rechnung erstellen kann.
Die Datei soll so aussehen, wie die Tabelle Rechnung.
Meine Probleme sind:
1. Durch das ganze auf und zumachen der Tabellen dauert dies zu lange, auf mich wirkt mein Code ganz schön primitiv, gibt es nicht eine elegantere Lösung?
2. Wenn ich am Ende die neu erstellte Datei als PDF speichern möchte, muss ich dies bestätigen, kann ich dies irgendwie umgehen und die Datei direkt speichern?
3. Geht es, dass es am Ende die neu erzeugte PDF Datei nicht auf geht, sondern einfach erzeugt und geschlossen bleibt?
4. Wenn die neu erzeugte Mappe mit dem Sheet name_new_wb schließe, bleibt ein leeres Excelfenster im Vordergrund offen, welches ich von Hand Schließen muss. Wie kann ich dies vermeiden? Wichtig ist, dass die Ausgangsdatei Rechnungsdatei offenbleibt, damit ich im nächsten Schritt eine weitere Rechnung erzeugen kann.
5. Ich wollte mit Worksheets("Rechnungstabelle").Range("A1:j80").Value = neue_mappe_neue_seite.Range("A1:J80").Value die Werte übertragen, aber ich habe dies leider nicht geschafft. Daher musste ich zu copy und paste greifen, nach dem ich eine Datei aus der Vorlage erzeugt habe.
Dies führt dazu, dass sich der zwischen Speicher füllt, wie kann ich diesen löschen? Bei ClearClipboard = True bekomme ich den Fehler, Variable nicht definiert!
Ich danke euch schon mal im Voraus für die Mühe.

LG Dimah
Hier ist mein Code.

Code:

Option Explicit

Sub Übertragen()
Dim new_name As String
Dim name_new_folder As String
Dim name_new_wb As String
Dim path_new_wb As String
Dim path_new_folder As String
Dim path_vorlagen As String
Dim name_new_pdf As String
Dim path_new_pdf As String
Dim pdfName As String
Dim ex As New Excel.Application

new_name = ThisWorkbook.Worksheets(1).Range("b17") & "-" & Format(ThisWorkbook.Worksheets(1).Range("A23"), "mm") & "-" & Format(ThisWorkbook.Worksheets(1).Range("B20"), "ddmmyyyy") & " - " & ThisWorkbook.Worksheets(1).Range("b16")
name_new_folder = Format(ThisWorkbook.Worksheets(1).Range("b19"), "mm.yyyy")
name_new_wb = new_name & ".xlsx"
path_new_wb = ThisWorkbook.Path & "" & name_new_folder & "" & name_new_wb
path_new_folder = ThisWorkbook.Path & "" & name_new_folder
path_vorlagen = ThisWorkbook.Path & "" '& "vorlagen"
name_new_pdf = new_name & ".pdf"
path_new_pdf = ThisWorkbook.Path & "" & name_new_folder & "" & name_new_pdf

Worksheets("Rechnung").Range("A1:j80").Value = ActiveSheet.Range("A1:J80").Value

' neuen Unterordner mit dem Namen " Wert des B19" von Sheest 1 erstellt

If Dir(ThisWorkbook.Path & "" & name_new_folder, vbDirectory) = "" Then
MkDir (ThisWorkbook.Path & "" & name_new_folder)
MsgBox "Ordner " & name_new_folder & " wurde " & "unter " & ThisWorkbook.Path & " angelegt! "
Else
MsgBox "Ordner " & name_new_folder & " ist unter " & path_new_folder & " vorhanden! "
End If

'erstellt eine neue Mappe, die im neu erstellten Ordner unter den Namen "Werte von b17-A23-B20-b16" gespeichert wird

ex.Visible = True

ex.Workbooks.Open path_vorlagen & "k_vorlage.xltx" 'Vorlage oeffnen
ex.ActiveWorkbook.SaveAs path_new_wb ' gerne hätte ich eine If schleife, die bei vorhandene Datei und nicht überschreiben wollen abbricht und nicht ein LAufzeitfehler ausgibt.
ex.ActiveWindow.Close True
'gerne würde ich auf schließen und wieder aufmachen der Datei verzichten, aber dann kommt Fehler "index außerhalb des gültigen Bereiches"
Workbooks.Open path_new_wb
Windows("Rechnungsdatei.xlsm").Activate
Sheets(2).Select
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Windows(name_new_wb).Activate
Range("A1").Activate
ActiveSheet.Paste
ActiveWorkbook.Save
pdfName = Application.GetSaveAsFilename(path_new_pdf, "PDF-Dateien (*.pdf), *.pdf")
Sheets(1).ExportAsFixedFormat Type:=xlTypePDF, Filename:=pdfName, _
Quality:=xlQualityStandard, IncludeDocProperties:=False, IgnorePrintAreas:=False, _
OpenAfterPublish:=True

ActiveWindow.Close True
'Application.Quit ' schließt nur meine Ausgangsdatei Rechnungsdatei und nicht das neue leere Excelfenster- Warum?

Windows("Rechnungsdatei.xlsm").Activate
Sheets(1).Select
'ClearClipboard = True ' keine Ahnung warumg das nicht geht
MsgBox "Die Datei " & name_new_wb & " wurde erzeugt."

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

bitte die Datei: k_vorlage als .xltx nochmal speichern.

:)

dimah · 8. März 2018

Niemand hier, der mir helfen kann?

evus · 9. März 2018

Hallo dimah,

versuch es mal mit diesem Code
Code:

Option Explicit

Sub Übertragen()
Dim WB As Workbook
Dim new_name As String

Dim name_new_wb As String
Dim path_new_wb As String

Dim name_new_pdf As String
Dim path_new_pdf As String

Dim name_new_folder As String
Dim path_new_folder As String

Set WB = ThisWorkbook 'ActiveWorkbook

new_name = WB.Worksheets(1).Range("b17") & "-" & _
Format(Range("A23"), "mm") & "-" & _
Format(Range("B20"), "ddmmyyyy") & " - " & Range("b16")

name_new_folder = Format(Worksheets(1).Range("b19"), "mm.yyyy")
path_new_folder = WB.Path & "\" & name_new_folder

name_new_wb = new_name & ".xlsx"
path_new_wb = WB.Path & "\" & name_new_folder & "\" & name_new_wb

name_new_pdf = new_name & ".pdf"
path_new_pdf = WB.Path & "\" & name_new_folder & "\" & name_new_pdf

' Daten in neues Sheet übertragen...
WB.Worksheets("Rechnung").Range("A1:J80").Value = _
WB.Worksheets("Rechnungstabelle").Range("A1:J80").Value

' und in neues (autom. erzeugtes) Workbook kopieren
WB.Worksheets("Rechnung").Copy

' neuen Unterordner mit dem Namen "Wert des B19" von Sheest 1 erstellt

If Dir(WB.Path & "\" & name_new_folder, vbDirectory) = "" Then
MkDir (WB.Path & "\" & name_new_folder)
MsgBox "Ordner " & name_new_folder & " wurde " & "unter " & WB.Path & " angelegt! "
Else
MsgBox "Ordner " & name_new_folder & " ist unter " & path_new_folder & " vorhanden! "
End If

' neues Workbook speichern
ActiveWorkbook.SaveAs Filename:=path_new_wb

' sowie auch als PDF-Datei (wird nicht geöffnet)
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=path_new_pdf, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False

' neues Workbook schließen
ActiveWorkbook.Close

MsgBox "Die Datei " & name_new_wb & " wurde erzeugt."
Set WB = Nothing
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Hinweis: die Vorlage "k_vorlage.xltx" wir nicht benötigt, ist ja identisch mit dem Worksheet "Rechnungen" in "Rechnungsdatei.xlsm". Eine zweite Excel-Instanz (für Workbook öffnen) braucht man auch nicht.

Fragen:
1.) soll die PDF-Datei im gleichen Ordner wie die Exceldatei gespeichert werden? (wenn ja, sind einige Variablen unnötig)
2.) ist eine Exceldatei schon vorhanden, darf der Benutzer den Namen dann ändern? (wenn ja, muss auch der Name der PDF-Datei geändert werden)
3.) muss denn VOR dem Speichern der Dateien eine Info (MsgBox) ausgegeben werden, wenn ein neuer Pfad angelegt, bzw. der ermittelte Pfad vorhanden ist?

rainer176 · 9. März 2018

Bevor du dich weiterquälst solltest du über eine Access-Lösung nachdenken.
Vorteile: Alle Rechnungen werden in der Datenbank gespeichert und können jederzeit gedruckt oder als PDF ausgegeben werden, komfortable Eingabemasken usw.
Wenn du mal googelst mit Rechnungen mit Access findest du sehr gute Beschreibungen wie das geht.

dimah · 12. Januar 2021

von evus

Fragen:
1.) soll die PDF-Datei im gleichen Ordner wie die Exceldatei gespeichert werden? (wenn ja, sind einige Variablen unnötig)
2.) ist eine Exceldatei schon vorhanden, darf der Benutzer den Namen dann ändern? (wenn ja, muss auch der Name der PDF-Datei geändert werden)
3.) muss denn VOR dem Speichern der Dateien eine Info (MsgBox) ausgegeben werden, wenn ein neuer Pfad angelegt, bzw. der ermittelte Pfad vorhanden ist?
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Hallo Evus,

erst ein Mal herzlichen Dank für deine Hilfe. Der Code funktioniert toll, habe mir das genau so vorgestellt.

nun zu den Fragen:

zu 1. Die pdfs sollten im gleichen Ordner wie die Excel gespeichert werden. Welche Variablen sind unnötig?

zu 2. Genau so ist es, wenn bereits eine Datei vorhanden ist, soll diese bleiben und die neue Datei soll vom Benutzer mit einem anderen Namen versehen werden, gilt natürlich auch für die pdfs.
Ich habe jetzt das Problem, dass wenn bei vorhandenen Dateien nicht überschrieben werden soll, die Fehlermeldung:Laufzeitfehler 1004 kommt, die und ich entweder Debuggen oder abbrechen muss. Ich hätte gerne eine If-Schleife, die dies abfängt und beim nicht überschreiben einfach beendet wird.

zu 3. Nein das muss nicht sein, hatte ich nur zur Kontrolle eingebaut.

dimah · 12. Januar 2021

von rainer176

Bevor du dich weiterquälst solltest du über eine Access-Lösung nachdenken.
Vorteile: Alle Rechnungen werden in der Datenbank gespeichert und können jederzeit gedruckt oder als PDF ausgegeben werden, komfortable Eingabemasken usw.
Wenn du mal googelst mit Rechnungen mit Access findest du sehr gute Beschreibungen wie das geht.
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Hallo Rainer,

danke für die Info.
Ich habe aber noch weniger Ahnung vom Access, brauche ich dafür nicht SQL- Kenntnisse und Server?
Wie erzeuge ich die Rechnungen?
Wie öffene ich diese?
wo liegt der Server?

Das alles hilt mich bisher davon ab, darüber nachzudenken.

Danke und LG

dimah · 10. März 2018

Hallo 2.0;
Da ich jetzt mit dem Code von Evus meine Rechnungen erzeugen kann, komme ich zu meinem nächsten Problem, womit ich wieder eure Hilfe bedarf.
Ich trage alle erbrachen Leistungen in dem WB Leistungsübersicht in Sheet 1 in der Übersichttabelle.
Wenn ich am Ende des Monats meine Rechnungen erstellen möchte, muss ich von Hand für jeden einzelnen Klienten von I1 U1 die Werte kopieren und diese in die Rechnungs-WB einfügen.
Dies mache ich wie folgt:
Zum Kopieren Beispiel von I1:
I1 Auswählen
So filtern, dass die leeren Zeilen ausgeblendet sind
Die Werte aus den Zeilen 6; 7 und 9 und zwar für die Spalten A-F auswählen und kopieren
Diese dann in dem WB-Rechnungsdatei / Sheet 1Tabelle 1 in den Spalten A-E und Reihen 23, 24 und 25 einfügen
Und dann die Rechnungen erzeugen. Ihr könnt euch vorstellen, dass dies schnell nervig und fehleranfällig werden kann.
Meine Frage ist, ob ich dies auch automatisieren kann und mit VBA abfragen kann.

Danke nochmal für die Mühe

rainer176 · 10. März 2018

Eine Access-Lösung erstellen ist keine Hexerei. Nachstehend ein Link:

https://www.ertls.de/dokumente/access_faktura.pdf

dimah · 11. März 2018

Danke für die Info Rainer,

habe jetzt so wie im Pdf Steht einige tabellen erstllt, aber ich weiss nicht wie ich die Oberfläche gestallten sol. Also bleiben ich lieber bei Excel.

evus · 11. März 2018

Hallo dimah,

Codeänderungen (u.a.):
- Sreenupdate für Verarbeitung ausgeschaltet
- zusätzliche Sub für Dateiprüfung
- vor dem Kopieren der "Rechnung" in eine neue Datei wird geprüft ob Datei bereits vorhanden. Benutzer kann Dateinamen ändern, oder Verarbeitung abbrechen, wobei bei Abbruch eine Info ausgegeben wird.
- wenn Subordner nicht vorhanden, wird dieser automatisch ohne Infoausgabe angelegt.
- Info am Ende, welche Datei wo gespeichert wurde
Code:

Option Explicit

Public Sub Übertragen()
Dim WB As Workbook
Dim new_name As String, pfadName As String

Application.ScreenUpdating = False

Set WB = ThisWorkbook
pfadName = WB.Path & "\"
pfadName = pfadName & Format(WB.Worksheets(1).Range("b19"), "mm.yyyy")
new_name = WB.Worksheets(1).Range("b17") & "-" & _
Format(Range("A23"), "mm") & "-" & _
Format(Range("B20"), "ddmmyyyy") & " - " & Range("b16")

' Prüfen ob Datei bereits vorhanden
CheckDatei pfadName & "\", new_name
If new_name = "" Then
MsgBox "Speichervorgang wurde abgebrochen.", vbExclamation
Exit Sub
End If

' Daten in neues Sheet übertragen...
WB.Worksheets("Rechnung").Range("A1:J80").Value = _
WB.Worksheets("Rechnungstabelle").Range("A1:J80").Value
' und in ein neues Workbook kopieren
WB.Worksheets("Rechnung").Copy

' Ordner anlegen falls nicht vorhanden
If Dir(pfadName, vbDirectory) = "" Then MkDir (pfadName)

' Neues Workbook speichern...
ActiveWorkbook.SaveAs Filename:=pfadName & "\" & new_name & ".xlsx"
ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, Filename:=pfadName & "\" & new_name & ".pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
' und schließen
ActiveWorkbook.Close

Application.ScreenUpdating = True
Set WB = Nothing

MsgBox "Name: " & new_name & Chr(13) & Chr(13) & _
"Ordner: " & pfadName, vbInformation, _
"Neue Excel- und PDF-Datei angelegt"
End Sub

'Prüfen ob Datei vorhanden, wenn ja, Namen ändern oder Abbruch...
Private Sub CheckDatei(pfName As String, new_name As String)
Dim txt As String
' Text für Inputbox
txt = """" & new_name & """" & Chr(13) & Chr(13) & _
"Diese Datei ist bereits vorhanden. Ändern Sie den Namen und " & _
"klicken Sie anschließend auf OK um die Datei zu speichern, " & _
"oder auf Abbrechen um den Vorgang abzubrechen." & Chr(13)
' Datei vorhanden?
If Not Dir(pfName & new_name & ".xlsx") = "" Then
' Eingabe neuer Name...
new_name = InputBox(txt, "Dateinamen ändern", new_name)
' und nochmals prüfen
If Not new_name = "" Then CheckDatei pfName, new_name
End If
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Kopier beide Subs in ein neues Modul und ändere den Namen der alten "Übertragen"-Sub um.

Grüße,
evus

dimah · 11. März 2018

Hallo Evus,

super Code, Danke sehr. Funktioniert Einwandfrei.
Bin Jetzt unverschämt und frage dich nochmal.

Hast du auch hierfür eine Lösung?

Hallo 2.0;
Da ich jetzt mit dem Code von Evus meine Rechnungen erzeugen kann, komme ich zu meinem nächsten Problem, womit ich wieder eure Hilfe bedarf.
Ich trage alle erbrachen Leistungen in dem WB Leistungsübersicht in Sheet 1 in der Übersichttabelle.
Wenn ich am Ende des Monats meine Rechnungen erstellen möchte, muss ich von Hand für jeden einzelnen Klienten von I1 U1 die Werte kopieren und diese in die Rechnungs-WB einfügen.
Dies mache ich wie folgt:
Zum Kopieren Beispiel von I1:
I1 Auswählen
So filtern, dass die leeren Zeilen ausgeblendet sind
Die Werte aus den Zeilen 6; 7 und 9 und zwar für die Spalten B-F auswählen "Anfang und Endzeit werde für die Rechung nicht benötigt" und kopieren
Diese dann in dem WB-Rechnungsdatei / Sheet 1Tabelle 1 in den Spalten A-E und Reihen 23, 24 und 25 einfügen
Und dann die Rechnungen erzeugen. Ihr könnt euch vorstellen, dass dies schnell nervig und fehleranfällig werden kann.
Meine Frage ist, ob ich dies auch automatisieren kann und mit VBA abfragen kann.

evus · 18. März 2018

Hallo dimah,

hatte leider keine Zeit mich früher zu melden - vielleicht kannst du ja den Code noch gebrauchen. Ein paar Änderungen sind aber in deinen Tabellen noch nötig.

Datei Leistungsübersicht.xlsx
- die Spalten in der Kopfzeile mit den Klientenkürzeln MM, ZM,... dürfen nicht mit dem Format "Buchhaltung" (???) formatiert werden, da Excel diese sonst nicht findet. Standard reicht.
- die Monster WENN-Formel in Spalte W (Zeile 2-11) könntest du ersetzen, Formel: =ANZAHL(Übersichtstabelle[@[MM]:[MY]])
- beim Filtern wird auch die Datumsspalte (B) berücksichtigt, wegen Zeile mit "Summe:" in Spalte A.

Datei Rechnungsdatei.xlsm
- Blatt "Rechnungstabelle", Zelle A30 - Text "Summe" ersetzen durch Formel: ="Summe". Grund: in der Tabelle "Kulturvermittlung" werden alle Werte vor dem Kopieren gelöscht (mit Ausnahme der letzten beiden Zeilen), die Formeln bleiben unverändert.
- Blatt "Hilfsseite", Zelle B1 - Formel eintragen: =INDEX(Kliententabelle[Kürzel];A1). Grund: wird benötigt für "suche Spalte mit den Klientendaten xy" in der Datei Leistungsübersicht.xlsx

Wozu Daten der Tabelle "Kliententabelle" per Formel auf das Blatt Hilfsseite übertragen werden, verstehe ich nicht. Wenn du das vereinfachen willst, musst du aber die Codezeile "kennung = .Worksheets("Hilfsseite").Range("B1").Value" anpassen.

Grüße,
evus

Code:

Option Explicit

Public Sub Daten_kopieren()
Dim wsZ As Worksheet
Dim wsZListe As ListObject
Dim wsQListe As ListObject
Dim zielZeile As Long
Dim zielSpalte As Integer
Dim kennung As String
Dim anzZeilen As Long
Dim i As Long, j As Integer

' max.Zeilen in Rechnungstabelle
Const maxZeilen As Integer = 6

On Error GoTo fehler
' Quelle
Set wsQListe = Workbooks("Leistungsübersicht.xlsx" _
).Worksheets("Leistungsübersicht" _
).ListObjects("Übersichtstabelle")
On Error GoTo 0
' Ziel
With ThisWorkbook
Set wsZ = .Worksheets("Rechnungstabelle")
Set wsZListe = wsZ.ListObjects("Kulturvermittlung")
kennung = .Worksheets("Hilfsseite").Range("B1").Value
End With

Application.ScreenUpdating = False
Application.Calculation = xlManual

' alte Daten löschen (keine Formeln!)
On Error Resume Next
wsZListe.DataBodyRange.SpecialCells(xlCellTypeConstants).ClearContents
On Error GoTo 0

' neue kopieren
If filterBereich(wsQListe, kennung) Then
anzZeilen = 0 'Zeilenzähler
zielZeile = 2 'ab Zeile 2
With wsQListe
For i = 2 To .ListRows.Count + 1
If Not .Range.Rows(i).RowHeight = 0 Then
zielSpalte = 1 'ab Spalte A

For j = 2 To 6 'von Spalte B-F
wsZListe.Range.Cells(zielZeile, zielSpalte).Value = _
.Range.Cells(i, j).Value
zielSpalte = zielSpalte + 1
Next j

zielZeile = zielZeile + 1
anzZeilen = anzZeilen + 1
If anzZeilen >= maxZeilen Then Exit For
End If
Next i
.AutoFilter.ShowAllData
End With
End If

Set wsQListe = Nothing
Set wsZListe = Nothing
Set wsZ = Nothing
Application.Calculation = xlAutomatic
Application.ScreenUpdating = True
MsgBox "Daten wurden kopiert.", vbInformation
Exit Sub
fehler:
MsgBox "Quelldatei nicht geöffnet oder fehlende Tabelle.", vbCritical
End Sub

'Tabelle filtern (Datum- und Klientenspalte "")
Private Function filterBereich _
(wsQListe As ListObject, kennung As String) As Boolean
Dim rng As Range
Dim spl As Integer
filterBereich = False
With wsQListe
' alle Zeilen anzeigen
If .ShowAutoFilter Then
If .AutoFilter.FilterMode Then .AutoFilter.ShowAllData
End If
.ShowAutoFilterDropDown = True
' Spalte bestimmen
spl = 0
Set rng = .Range.Rows(1).Find(What:=kennung, LookIn:=xlValues, _
LookAt:=xlWhole, MatchCase:=False)
If Not rng Is Nothing Then spl = rng.Column
Set rng = Nothing
If spl = 0 Then Exit Function
' filtern
.Range.AutoFilter Field:=spl, Criteria1:=""
.Range.AutoFilter Field:=2, Criteria1:=""
End With
filterBereich = True
End Function
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

dimah · 12. Januar 2021

WAW,
danke Evus, genau so sollte es sein.

Geil*Smilie

von evus

Hallo dimah,

hatte leider keine Zeit mich früher zu melden - vielleicht kannst du ja den Code noch gebrauchen. Ein paar Änderungen sind aber in deinen Tabellen noch nötig.

Datei Leistungsübersicht.xlsx
- die Spalten in der Kopfzeile mit den Klientenkürzeln MM, ZM,... dürfen nicht mit dem Format "Buchhaltung" (???) formatiert werden, da Excel diese sonst nicht findet. Standard reicht.
- die Monster WENN-Formel in Spalte W (Zeile 2-11) könntest du ersetzen, Formel: =ANZAHL(Übersichtstabelle[@[MM]:[MY]])
- beim Filtern wird auch die Datumsspalte (B) berücksichtigt, wegen Zeile mit "Summe:" in Spalte A.

[/code]
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

dimah · 12. Januar 2021

Ich nochmal,

eine Frage habe ich noch.
jetzt habe ich bei der Überlegung eine Sache vergessen.
Ich stelle die Rechnung mtl.
In der Leistungsübersicht trage ich aber alle Leistungen des Jahres ein.
Wenn ich mit dem Code Kopiere bekomme ich da ein Problem.

Nun meine Frage:

Wenn ich in dem WB Rechnungsdatei in WS Rechnungstabelle Zelle "B19" den Monat manuel eintrage, wie kann ich nur diesen Monat aus der "Leistungsübersicht" kopieren und nicht die gesamte Tabelle.

Danke in Vorraus.

von evus

Hallo dimah,

hatte leider keine Zeit mich früher zu melden - vielleicht kannst du ja den Code noch gebrauchen. Ein paar Änderungen sind aber in deinen Tabellen noch nötig.

[/code]
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

evus · 24. März 2018

Hallo dimah,

trage in Zelle "B19" Monat/Jahr manuell ein und ändere in der Sub Daten_kopieren die Zeile
von
If filterBereich(wsQListe, kennung) Then
in
If filterBereich(wsQListe, kennung, wsZ.Range("B19").Value) Then

und ersetzte die Function filterBereich durch folgenden Code:
Code:

'Tabelle filtern (von/bis Datum und Klientenspalte "")
Private Function filterBereich _
(wsQListe As ListObject, kennung As String, datum As String) As Boolean
Dim rng As Range
Dim spl As Integer
Dim vd As Date, bd As Date
filterBereich = False
With wsQListe
' alle Zeilen anzeigen
If .ShowAutoFilter Then
If .AutoFilter.FilterMode Then .AutoFilter.ShowAllData
End If
.ShowAutoFilterDropDown = True
' Spalte bestimmen
spl = 0
Set rng = .Range.Rows(1).Find(What:=kennung, LookIn:=xlValues, _
LookAt:=xlWhole, MatchCase:=False)
If Not rng Is Nothing Then spl = rng.Column
Set rng = Nothing
If spl = 0 Then Exit Function
' filtern, Klientelkürzel ...
.Range.AutoFilter Field:=spl, Criteria1:=""
' und von/bis Datum (Monat)
If IsDate(datum) Then
vd = "01." & Format(datum, "mm.yyyy")
bd = Format(DateSerial(Year(datum), Month(datum) + 1, 0), "dd.mm.yyyy")
.Range.AutoFilter Field:=2, _
Criteria1:=">=" & CLng(vd), Operator:=xlAnd, Criteria2:="
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Office: (Office 2013) Rechungen mit VBA erstellen und als PDF speichern.

Rechungen mit VBA erstellen und als PDF speichern.

Rechungen mit VBA erstellen und als PDF speichern.

Rechungen mit VBA erstellen und als PDF speichern.

Rechungen mit VBA erstellen und als PDF speichern.

Rechungen mit VBA erstellen und als PDF speichern.

Rechungen mit VBA erstellen und als PDF speichern. - Similar Threads - Rechungen VBA erstellen

Datei in mehreren Ordnern suchen und wenn gefunden öffnen?! Macro / VBA

Textteile aus Zelle mit mehreren Absätzen

Aufrufen Datei aus SharePoint per VBA

VBA: Spalten auf anderen Worksheeds in der Mappe ausblenden.

VBA Zeilen kopieren mit Bedingung

VBA - Datensätze ans Ende einer anderen Tabelle kopieren

Laufzeitfehler 9 VBA