Hallo Leute,
da ich ein VBA Neuling bin, entschuldige ich mich für die Fehler und bitte um eure Hilfe.
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 Rechnungstabelle in einer neu erstellten Tabelle mit dem Rechnungsnamen (bestehend aus Daten, die sich aus der Rechnungstabelle ergeben) übertragen. Die Datei soll als Excel und pdf in einem neuen Ordner mit dem Namen des Rechnungsmonats 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. Ist es möglich, dass zum Schluss die neu erzeugte PDF Datei nicht aufgeht, sondern einfach erzeugt und geschlossen bleibt?
4. Wenn ich 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.
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
Sub entf()
'
' delet Makro
' zum löschen der Rechnungtabelle
'
' Tastenkombination: Strg+q
'
Sheets("Rechnung").Select
Cells.Select
Selection.ClearContents
Sheets(1).Select
MsgBox "Alle Daten gelöscht!"
End Sub