Office: (Office 2007) Problem mit abspeichern als pdf

Hallo liebe VBA-ler,
ich habe folgendes Problem. In meinem Code wird jetzt die Geschriebene Rechnung als "xlsx" abgespeichert, soll aber in Zukunft als pdf gespeichert werden. Ich hatte zwar die entsprechende Zeile geändert aber nur Fehlermeldungen bekommen. Ganz ehrlich weis ich nicht mehr weiter.
Im nachfolgenden Code wird zuerst abgefragt in welchen Ordner ich speichern möchte
-dann wird gespeichert (in Zukunft als pdf)
-dann wird das Originalformular wieder geöffnet um die Re.Nr. um 1 zu erhöhen
-anschließend wird das Originalformular gespeichert und geschlossen
-Im nächsten Schritt wird die Datei OPOS geöffnet und Re.datum, Kundennamen,ReNummer und Betrag eingetragen
Die geschriebene Rechnung wird geschlossen, geöffnet bleibt die Datei OPOS.
Fehlermeldungen waren z.B. Datei kann nicht geöffnet werden weil Sie bereits geöffnet ist. Ein anderes mal wird die ReNummer in OPOS um eins erhöht.
Nun der Code: Ist zwar nicht immer den Regeln entsprechend, aber funktioniert
Die kompletten Pfade wurden leider nicht übernommen, so dass ich sie gekürzt habe.
Wär schön wenn jemand eine Lösung hätte!
Werner

Private Sub CommandButton6_Click() 'Speichern
Dim Mldg, Stil, Titel, Antwort
Mldg = "Im 16%-Ordner ?"
Stil = 36
Titel = "Speichern !"
Antwort = MsgBox(Mldg, Stil, Titel)
If Antwort = vbYes Then
Dim strFullName As String
Dim wbkOriginal As Workbook

Dim wbkRechnungen As Workbook
Dim wbkOPOS As Workbook
Dim wksZiel As Worksheet
Dim wksQuelle As Worksheet
Dim lngZeile As Long
Dim lngLetzteZeile As Long

Set wbkRechnungen = Workbooks("Rechnungen.xlsm")
Set wksQuelle = wbkRechnungen.Worksheets("Tabelle1")

Set wbkOriginal = Workbooks("Rechnungen.xlsm")

Application.ScreenUpdating = False
If ThisWorkbook.Name "Rechnungen.xlsm" Then Exit Sub 'Name ggf. Anpassen!!!!!!!!!!!!!!!!!
strFullName = ThisWorkbook.FullName

ActiveSheet.Cells(8, 7).Value = ActiveSheet.Cells(8, 7).Value 'Diese Zeile verhindert dass sich beim erneuten Öffnen Datum ändert
Range("A8").Select
' Die nächste Zeile speichert unter Re.Nr. und Kd.-Namen
ThisWorkbook.SaveAs "C:users...16%" & ActiveSheet.Cells(10, 7).Text & "-" & ActiveSheet.Cells(8, 1).Text & ".xlsm"
DoEvents

Set wbkOriginal = Workbooks.Open(Filename:=strFullName) 'Die nächste Zeile erhöht die Re.Nr. um 1

wbkOriginal.Worksheets("Tabelle1").Cells(10, 7).Value = Val(wbkOriginal.Worksheets("Tabelle1").Cells(10, 7).Value) + 1
wbkOriginal.Save

Dim lngLetzteZeileSpalteA As Long
Dim lngLetzteZeileSpalteB As Long
Dim lngLetzteZeileSpalteE As Long
Dim lngLetzteZeileSpalteG As Long

Dim lngSpalte As Long
Workbooks.Open "C:Users...OPOS.xlsm"

Set wbkOPOS = Workbooks("OPOS.xlsm")
Set wksZiel = wbkOPOS.Worksheets("Tabelle1")

lngSpalte = 1 'Diese beiden Zeilen weisen die erste freie Zeile an
lngLetzteZeileSpalteA = wksZiel.Cells(wksZiel.Rows.Count, lngSpalte).End(xlUp).Row
lngSpalte = 2 'Diese beiden Zeilen weisen die erste freie Zeile an
lngLetzteZeileSpalteB = wksZiel.Cells(wksZiel.Rows.Count, lngSpalte).End(xlUp).Row
lngSpalte = 5 'Diese beiden Zeilen weisen die erste freie Zeile an
lngLetzteZeileSpalteE = wksZiel.Cells(wksZiel.Rows.Count, lngSpalte).End(xlUp).Row
lngSpalte = 6 'Diese beiden Zeilen weisen die erste freie Zeile an
lngLetzteZeileSpalteG = wksZiel.Cells(wksZiel.Rows.Count, lngSpalte).End(xlUp).Row

wksZiel.Cells(lngLetzteZeileSpalteA + 1, 1).Value = wksQuelle.Cells(8, 7).Value
wksZiel.Cells(lngLetzteZeileSpalteB + 1, 2).Value = wksQuelle.Cells(8, 1).Value
wksZiel.Cells(lngLetzteZeileSpalteE + 1, 5).Value = wksQuelle.Cells(10, 7).Value
wksZiel.Cells(lngLetzteZeileSpalteG + 1, 6).Value = wksQuelle.Cells(36, 7).Value

Workbooks("Rechnungen.xlsm").Close SaveChanges:=True
ThisWorkbook.Close

Application.ScreenUpdating = True
End If

If Antwort = vbNo Then

Set wbkRechnungen = Workbooks("Rechnungen.xlsm")
Set wksQuelle = wbkRechnungen.Worksheets("Tabelle1")

Set wbkOriginal = Workbooks("Rechnungen.xlsm")

Application.ScreenUpdating = False
If ThisWorkbook.Name "Rechnungen.xlsm" Then Exit Sub 'Name ggf. Anpassen!!!!!!!!!!!!!!!!!
strFullName = ThisWorkbook.FullName

ActiveSheet.Cells(8, 7).Value = ActiveSheet.Cells(8, 7).Value 'Diese Zeile verhindert dass sich beim erneuten Öffnen Datum ändert
Range("A8").Select
' Die nächste Zeile speichert unter Re.Nr. und Kd.-Namen
ThisWorkbook.SaveAs "C:users....7%" & ActiveSheet.Cells(10, 7).Text & "-" & ActiveSheet.Cells(8, 1).Text & ".xlsm"
DoEvents

Set wbkOriginal = Workbooks.Open(Filename:=strFullName) 'Die nächste Zeile erhöht die Re.Nr. um 1

wbkOriginal.Worksheets("Tabelle1").Cells(10, 7).Value = Val(wbkOriginal.Worksheets("Tabelle1").Cells(10, 7).Value) + 1
wbkOriginal.Save

Workbooks.Open "C:Users...OPOS.xlsm"

Set wbkOPOS = Workbooks("OPOS.xlsm")
Set wksZiel = wbkOPOS.Worksheets("Tabelle1")

lngSpalte = 1 'Diese beiden Zeilen weisen die erste freie Zeile an
lngLetzteZeileSpalteA = wksZiel.Cells(wksZiel.Rows.Count, lngSpalte).End(xlUp).Row
lngSpalte = 2 'Diese beiden Zeilen weisen die erste freie Zeile an
lngLetzteZeileSpalteB = wksZiel.Cells(wksZiel.Rows.Count, lngSpalte).End(xlUp).Row
lngSpalte = 5 'Diese beiden Zeilen weisen die erste freie Zeile an
lngLetzteZeileSpalteE = wksZiel.Cells(wksZiel.Rows.Count, lngSpalte).End(xlUp).Row
lngSpalte = 6 'Diese beiden Zeilen weisen die erste freie Zeile an
lngLetzteZeileSpalteG = wksZiel.Cells(wksZiel.Rows.Count, lngSpalte).End(xlUp).Row

wksZiel.Cells(lngLetzteZeileSpalteA + 1, 1).Value = wksQuelle.Cells(8, 7).Value
wksZiel.Cells(lngLetzteZeileSpalteB + 1, 2).Value = wksQuelle.Cells(8, 1).Value
wksZiel.Cells(lngLetzteZeileSpalteE + 1, 5).Value = wksQuelle.Cells(10, 7).Value
wksZiel.Cells(lngLetzteZeileSpalteG + 1, 6).Value = wksQuelle.Cells(36, 7).Value

Workbooks("Rechnungen.xlsm").Close SaveChanges:=True
ThisWorkbook.Close

Application.ScreenUpdating = True
End If
End Sub

:)

 

Hallo Werner,
um ein Blatt einer Arbeitsmappe als PDF zu speichern gibt es grundsätzlich zwei Möglichkeiten:

• als PDF drucken oder
• die Office-Exportfunktion

Die Arbeitsmappe könnte dann in beiden Fällen geöffnet bleiben.
Hier mal ein Beispiel für die Export-Funktion:
Code:

 

Danke erstmal für deine Überlegung.
Das Problem ist nicht die Erstellung der Pdf-Datei sondern dass die Originaldatei nach dem Speichern nicht wieder leer ist und deshalb das workbook.open Ereigniss fehlschlägt.
So wird zwar die Pdf erstellt, aber quasi das Original Rechnungsformular "Zerstört".
Damit dass die Rechnungsnummer jeweils um 1 zu hoch ist könnt ich grad noch leben.
Nochmals Danke, vielleicht hättest du noch einen anderen Ansatz?!
Gruß Werner

 

Vermutlich habe ich das Problem jetzt verstanden:
Du öffnest die Datei und startest das Makro
Während der Laufzeit speicherst du die Datei unter neuem Namen, das Makro läuft weiter.
Deshalb kannst du das Original nochmals öffnen, um den Zähler zu erhöhen.
Beim Speichern bzw. Exportieren als PDF funktioniert das nicht, denn das Original bleibt geöffnet und beim erneuten Öffnen läuft das Makro nicht weiter.

Als Zwischenlösung würde ich vorschlagen, die PDF zunächst zusätzlich zu erstellen, also die Zeile ThisWorkbook.SaveAs "C:...%,,, stehen zu lassen und danach zusätzlich noch den PDF-Export anzuhängen.

Wie ich das Problem löse fällt mir dann frühestens nach dem Abendessen ein...

 

Dafür gibt es doch den Dateityp Excelvorlage. Damit hast du immer eine leere Vorlage. Und das Problem mit der Rechnungsnummer ist in Wahrheit keines, denn es steht nirgendwo geschrieben, dass eine Rechnungsnummer fortlaufend sein muss. Sie muss nur eindeutig sein. Daher bietet sich z.B. Datum in Kombination mit Uhrzeit als Rechnungsnummer an. Diese sind eindeutig, wenn man davon ausgeht, dass vermutlich niemand innerhalb der gleichen Sekunde 2 Rechnungen erstellen kann.

 

Das mit der Vorlage wird mit der hier genutzten Vorgehensweise nicht gelingen. Dazu müsste während der Laufzeit aus der Kopie wieder die Original-Vorlage geöffnet werden um den Zähler zu erhöhen. Das erlaubt Excel aber nicht.

Hier mal ein Ansatz:
Statt die Datei unter neuem Namen zu speichern und dann wieder zu öffnen habe ich das betreffende Arbeitsblatt kopiert, daraus die PDF erstellt und dann wieder gelöscht. So kannst du dir das erneute Öffnen der Datei sparen.
Ebenso werden nicht mehr alle Variablen gebraucht.

Ganz ausgearbeitet habe ich das Makro nicht. Ich habe mir nur den "Ja"-Fall vorgenommen. Die 7%-Variante habe ich mir nicht angeschaut.

Code:

 

Also mit Excel 2010 geht das - gerade nochmal verifiziert.

Gruß Ulrich

 

Das ist erstens nicht wahr - warum sollte ich das Original (das ja nicht mehr offen ist, wenn es bereits als Kopie gespeichert wurde) nicht mehr zu öffnen sein?
Und zweitens ist es - wie ich bereits geschrieben habe - völlig unnötig, wenn man den Punkt mit dem Zähler einfach weglässt. Dieser bringt keinerlei Vorteil, sondern nur Mehraufwand, wie man hier erkennen kann.

 

Ja. Geht. Mein Fehler.
Trotzdem bin ich der Meinung, mein Änderung funktioniert, ohne dass das Makro neu geschrieben werden muss. Die Variante mit der Vorlage bringt m. E. sehr viele Änderungen mit sich und wäre mehr Aufwand.

 

Moin!
Dass das ein Totschlagargument ist, weist Du wohl selbst.
Es ist imo allemal sinnvoller, die Ursache abzustellen, als am Symptom herumzudoktern.

Nur meine Meinung.
Gruß Ralf

 

Guten Morgen euch allen,
ich kann`s aus Zeitgründen heute nicht austesten, bin aber froh und dankbar dass ihr euch meines Problems wegen soviel Kopfzerbrechen bereitet. Aber es gibt ja noch ein Wochenende*Smilie .
Ich melde mich dann wieder wie ich´s gelöst habe. Danke schon mal!
Werner

 

Hallo erst mal.
Wie versprochen hier meine Lösung:
Ich habs so gelöst dass jetzt sowohl die Excel Datei als auch das pdf gespeichert wird. Ansonsten hatte ich nur Probleme.
Evtl. bau ich noch einen "Kill" Befehl ein der die Excel Dateien dann löscht.
Vielen Dank noch mal besonders an Wolfgang!
Gruß Werner