Excel 2016 VBA Makro PDF Drucken läuft auf Fehler

Phill_HF

Ensign
Dabei seit
März 2016
Beiträge
171
Hallo,

folgender Sachverhalt.

Wir haben eine Tabelle die Änderungen an Wartungsverträgen enthält und durch den Anwender selbst aktualisiert werden kann.
Eine Kollegin die nicht mehr im Unternehmen ist hat die Tabelle für die Anwender so vereinfacht das diese nur auf einen Knopf drücken müssen das sich diese Tabelle aktualisiert und je nach Niederlassung ein PDF in einen definierten Ordner abspeichert.

Die Datei läuft aber seit neustem auf einen Fehler:
1586418130473.png


1586418150698.png


Die Tabelle aktualisiert wohl die Daten und immer wenn die Daten einer Niederlassung aktualisiert wurden und ein PDF erstellt werden voll kommt der Laufzeitfehler.

Wäre Super wenn mir jemand helfen könnte das die blöde Tabelle wieder funktioniert.

Edit: hier das Makro bis zum Fehler:

Sub Generierung()

'Stellt die Bildschirmaktualisierung aus (Kein Flackern)
Application.ScreenUpdating = False

'Anzeigen des aktuellen Status unten links in der Statusleiste
Application.StatusBar = "Bearbeitung läuft..."


'Reiter Daten auswählen und Datenbasis aktualisieren
Sheets("Daten").Select
Range("A1").Select
Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False
Application.StatusBar = False


'alle Zeilen in Tabelle löschen, bei denen Spalte C nicht gefüllt ist
Range("C:C").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

'Reiter Daten Sortierung Spalte Neuvertrag
ActiveWorkbook.Worksheets("Daten").ListObjects("Tabelle_Abfrage_von_HSMP333"). _
Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Daten").ListObjects("Tabelle_Abfrage_von_HSMP333"). _
Sort.SortFields.Add Key:=Range( _
"Tabelle_Abfrage_von_HSMP333[[#All],[Neuvertrag]]"), SortOn:=xlSortOnValues, _
Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Daten").ListObjects( _
"Tabelle_Abfrage_von_HSMP333").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

'Dublikate zur Bestimmung der NLs entfernen
Columns("A:A").Select
Selection.Copy
Sheets("Hilfen").Select
Columns("A:A").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveSheet.Range("$A$1:$A$100000").RemoveDuplicates Columns:=1, Header:=xlNo

'NL Aufstellung aufsteigend sortieren
Sheets("Hilfen").Select
Range("A2:A16").Select
ActiveWorkbook.Worksheets("Hilfen").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Hilfen").Sort.SortFields.Add Key:=Range("A2"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Hilfen").Sort
.SetRange Range("A2:A16")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

'Anzahl NL definieren
Anzahl = Range("C1")
Auswertungsmonat = Range("C2")

For i = 1 To Anzahl

Range("A1").Select
NL = ActiveCell.Offset(i, 0)

'Wechsel auf Reiter Daten
Sheets("Daten").Select

'Angaben zu Folgeaktion (bzw. -vertrag) für "Neuvertrag" und "Vertragsänderung" löschen
ActiveSheet.ListObjects("Tabelle_Abfrage_von_HSMP333").Range.AutoFilter Field _
:=2, Criteria1:="<>"
ActiveSheet.ListObjects("Tabelle_Abfrage_von_HSMP333").Range.AutoFilter Field _
:=11, Criteria1:="Neuvertrag", Operator:=xlOr, Criteria2:= _
"=Vertragsänderung"
Range("Tabelle_Abfrage_von_HSMP333[Folgeaktion]").Select
Selection.ClearContents
ActiveSheet.ListObjects("Tabelle_Abfrage_von_HSMP333").Range.AutoFilter Field _
:=11
ActiveSheet.ListObjects("Tabelle_Abfrage_von_HSMP333").Range.AutoFilter Field _
:=2

'Filter auf NL setzen (und Gesamtsummen rausnehmen)
ActiveSheet.ListObjects("Tabelle_Abfrage_von_HSMP333").Range.AutoFilter Field _
:=1, Criteria1:=NL, Operator:=xlAnd
'ActiveSheet.ListObjects("Tabelle_Abfrage_von_HSMP333").Range.AutoFilter Field _
:=3, Criteria1:="<>"

'Auswahl kopieren und in Tabellenblatt Auswertung einfügen
Range("A1:R10000").Select
Selection.Copy
Sheets("Auswertung").Select
Range("A4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'Neue verkürzte Kopf/Beschriftungszeile einfügen
Sheets("Hilfen").Select
Range("F1:W1").Select
Selection.Copy
Sheets("Auswertung").Select
Range("A4").Select
ActiveSheet.Paste

'Neue Konditionsvereinbarung benennen
Sheets("Auswertung").Select
LetzteZeile = Range("R1000000").End(xlUp).Row

Range("T5").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-19]="""","""",IF(RC[-17]=""Prüfung und Wartung Komfort"",""Prüfung und Wartung"",IF(RC[-17]=""Einmal-Wartung"",""Einmal-Wartung"",MID(RC[-17],24,100))))"
Range("T5").Select
Selection.Copy
Range("T5:T" & LetzteZeile).Select
ActiveSheet.Paste

'neue Konditionsvereinbarung in Zeile C einfügen
Range("T5:T" & LetzteZeile).Select
Selection.Copy
Range("C5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'Werte aus Zeile T löschen
Columns("T:T").Select
Selection.ClearContents

'Umwandlung als Text gespeicherte Zahl in eine Zahl umwandeln
For x = 5 To LetzteZeile
Cells(x, 16) = CLng(Cells(x, 16))
Cells(x, 16).NumberFormat = "General"
Cells(x, 17) = CLng(Cells(x, 17))
Cells(x, 17).NumberFormat = "General"
Cells(x, 18) = CLng(Cells(x, 18))
Cells(x, 18).NumberFormat = "General"
Next

Range("E5").Select


'Teilergebnisse für die Spalten Anlagenanzahl alt, neu, Differenz nach Merkmal Neuvertrag bilden
Selection.Subtotal GroupBy:=11, Function:=xlSum, TotalList:=Array(16, 17, 18) _
, Replace:=True, PageBreaks:=False, SummaryBelowData:=True


'Formel für die Bedingte Formatierung einfügen, da diese sonst in den Ergebnisspalten nicht da ist
Ende_NEU = LetzteZeile + 4

Range("S5").Select
ActiveCell.FormulaR1C1 = _
"=IF(NOT(ISERROR(FIND(""Gesamtergebnis"",RC[-8]))),""XX"",IF(NOT(ISERROR(FIND(""Ergebnis"",RC[-8]))),""X"",""""))"
Range("S5").Select
Selection.Copy
Range("S6:S" & Ende_NEU).Select
ActiveSheet.Paste

'Zeilenumbruch für Spalte M (Bemerkung) einfügen
Columns("M:M").Select
With Selection
.WrapText = True
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("A5:R" & LetzteZeile).Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlCenter
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With


'Datei als PDF abspeichern
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"T:\Service-Zentrale\Projekt-HSM\Statistik\Auswertungen Änderung P&W Verträge\" & NL & "\Änderung P&W Anlagenbestand " & NL & " - " & Auswertungsmonat & ".pdf", Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False
 
Zuletzt bearbeitet:

burglar225

Lt. Commander
Dabei seit
Juni 2004
Beiträge
1.313
So wird dir hier vermutlich niemand helfen können. Eine einzelne Zeile des Codes ist sinnfrei. Evtl. hast du Glück und das ist ein bekannter Fehler, aber die Meldung oben ist auch nicht besonders aussagekräftig, ich schätze also eher nein.
Die Frage, die sich mir stellt ist aber erstmal eine andere. Es hat ja die ganze Zeit wohl funktioniert, was hat sich jetzt also geändert, dass es nicht mehr funktioniert?
 

Phill_HF

Ensign
Ersteller dieses Themas
Dabei seit
März 2016
Beiträge
171
Ich kann gerne alles Posten das ist nicht das Thema dachte das es o übersichtlicher ist. Was sich verändert hat nichts ausser den ganz normalen Office Updates.
 

G-Red

Lt. Commander
Dabei seit
Jan. 2016
Beiträge
1.923
Ist der Gelbmarkierte Codeabschnitt der, nach dem die Fehlermeldung auftaucht?
 

burglar225

Lt. Commander
Dabei seit
Juni 2004
Beiträge
1.313
Prinzipiell kann ich auf die schnelle kein Problem sehen, was aber überhaupt nichts zu heißen hat. Ich kann (und will) hier jetzt nicht im Detail den Code analysieren, zumal ich den Fehler eh nicht im Code vermute.
In der von dir angegebenen Anweisung wird eine PDF-Datei im Dateisystem erstellt. Hast du geprüft, ob der Pfad, auf den Zugegriffen wird, existiert und, ob Schreibberechtigungen bestehen?
Ergänzung ()

@G-Red Sieht ganz so aus, der Debugger steht ja an der Stelle.
 

G-Red

Lt. Commander
Dabei seit
Jan. 2016
Beiträge
1.923

Phill_HF

Ensign
Ersteller dieses Themas
Dabei seit
März 2016
Beiträge
171
Also die gelbe Markierung ist der Punkt an dem das makro abbricht. Ja die Pfade sind korrekt und uahc vorhanden. Ich habe mal mit meinen geringen VBA Kentnissen geschaut und konnta auch nichts finden z.B. der komplette gelbe beriech wurde von einer Microsoft Support seite so übernommen da wurde nichts selbst geschrieben.
 

G-Red

Lt. Commander
Dabei seit
Jan. 2016
Beiträge
1.923
Kannst du den unter dem angegebenen Pfad selbst was erstellen? Probier da einfach eine Textdatei zu erstellen, es könnte nämlich sein dass die Schreibrechte in den Ordnern verändert worden sind.
 

Sun_set_1

Captain
Dabei seit
Sep. 2008
Beiträge
3.799
Das Problem ist halt, das in dem Pfad auch zig Strings verarbeitet werden, die vorher durch die Prozedur erstellt werden. Theoretisch kann also jeder dieser Strings den Pfad korrumpieren. Einfachste Möglichkeit wäre den Pfad mal testweise auf den eigenen Desktop zu ändern und höchsten die String-Variable beim Dateinamen drinnen lassen. Wenns dann geht liegt’s entweder an Berechtigungen oder eben einem defekten String. Nur den ohne Beispieldateien und richtiger Umgebung zu finden, kannste fast vergessen.
 

xdave78

Captain
Dabei seit
Juli 2011
Beiträge
3.331
Hast Du mal nen "einfachen" Pfad wie einfach nur T:\Test probiert um auszuschließen, dass der Fehler im Pfad/ irgendwelchen Zeichen selbst liegt?
 

G-Red

Lt. Commander
Dabei seit
Jan. 2016
Beiträge
1.923
Ersetze mal diesen Code
Code:
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"T:\Service-Zentrale\Projekt-HSM\Statistik\Auswertungen Änderung P&W Verträge\" & NL & "\Änderung P&W Anlagenbestand " & NL & " - " & Auswertungsmonat & ".pdf", Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False

durch diesen. Das speichert dir die Datei TEST.pdf auf deinen Desktop
Code:
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
Environ("USERPROFILE") & "\Desktop\TEST.pdf", Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False
 
Zuletzt bearbeitet:

Sun_set_1

Captain
Dabei seit
Sep. 2008
Beiträge
3.799
Code:
'Anzahl NL definieren
Anzahl = Range("C1")
Auswertungsmonat = Range("C2")

For i = 1 To Anzahl

Range("A1").Select
NL = ActiveCell.Offset(i, 0)

Code:
'Datei als PDF abspeichern
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"T:\Service-Zentrale\Projekt-HSM\Statistik\Auswertungen Änderung P&W Verträge\" & NL & "\Änderung P&W Anlagenbestand " & NL & " - " & Auswertungsmonat & ".pdf",

Habt ihr eventuell eine Niederlassung in den Stammdaten, die Sonderzeichen enthält, oder sonstwie komisch benannt ist? Sind eventuell Leerwerte vorhanden? Sprich leere Zellen. Laut Code sollten entfernt werden, aber sowas knallt gerne mal.
 

Phill_HF

Ensign
Ersteller dieses Themas
Dabei seit
März 2016
Beiträge
171
@G-Red "Userprofile" da muss mein User rein korrekt?
Ergänzung ()

@Sun_set_1 nein die Niederlassungen sind alle gleich z.b. N11 N12 ....
 

G-Red

Lt. Commander
Dabei seit
Jan. 2016
Beiträge
1.923

Sun_set_1

Captain
Dabei seit
Sep. 2008
Beiträge
3.799

Phill_HF

Ensign
Ersteller dieses Themas
Dabei seit
März 2016
Beiträge
171
@G-Red okay das hat funktioniert jetzt hängt er beim nachfolgenden Teil:
'Ablage der PDFs in SKO-Ordner
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"T:\Service-Zentrale\Regionalleiter ST\Statistiken\Auswertung Änderungen P&W Verträge\" & NL & "\Änderung P&W Anlagenbestand " & NL & " - " & Auswertungsmonat & ".pdf", Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False

Ich würde jetzt vermuten das es wirklich ein Problem mit den Ordnern gibt oder ?
Ergänzung ()

@Sun_set_1 die Daten werden jedesmal per SQL aus der Datenbank geholt. In der Tabelle befinden sich nur die E-mail Adressen der Personen die das per Mail bekommen sollen.
 

G-Red

Lt. Commander
Dabei seit
Jan. 2016
Beiträge
1.923
Due kannst den Pfadteil durch den ersetzen den ich davor gezeigt habe. Allerdings denke ich, es hängt nicht an dem Speicherort, sondern tatsächlich an den Daten. Kannst du vielleicht vor der genannten Zeile Code,
Code:
Debug.Print NL
eintragen und den Inhalt posten?
 

Phill_HF

Ensign
Ersteller dieses Themas
Dabei seit
März 2016
Beiträge
171
So korrekt? läuft immer auf den gleichen Fehler

Debug.Print NL
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"T:\Service-Zentrale\Regionalleiter ST\Statistiken\Auswertung Änderungen P&W Verträge\" & NL & "\Änderung P&W Anlagenbestand " & NL & " - " & Auswertungsmonat & ".pdf", Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False
 
Top