Makro PDF erzeugen - Fehler

[WatchAroundQS]

Hallo zusammen,

ich bin neu hier und habe in meiner Prüfmittelüberwachung ein riesen Problem mit einem Makro, dass mir dieses Tabellenblatt, als PDF speichern soll und damit ich den "Kalibrierschein" extra als Dokument habe, dieses den Dateinamen zusammengestellt aus EXKS-2016-"und die Nr. aus Zelle C5"
Ich habe es schon öfter geschaft den Fehler zu beheben nur taucht er immer wieder auf und ich verstehe einfach nicht wo der Fehler ist und warum es ab und zu geht und dann wieder nicht.

Die ganze Excel Tabelle möchte ich jetzt nicht hier online stellen, da es doch eine riesen Datei ist und betriebsinterne Daten enthält. Ich werde aber natürlich alles tun, damit ihr mir helfen könnt.

Hier das Makro mit dem Fehler (Gelbe Schrift)

---

PHP-Code:

Sub PDF_prüfen()
   'Beginn PDF erzeugen
   'Beginn abfrage ob alle Felder ausgefüllt
   If Sheets("F-210_01.1a Kalibrierschein").Range("F5") <> "" Then
      If Sheets("F-210_01.1a Kalibrierschein").Range("B7") <> "" Then
         If Sheets("F-210_01.1a Kalibrierschein").Range("C48") <> "" Then
            If Sheets("F-210_01.1a Kalibrierschein").Range("B45") <> "" Then
               If Sheets("F-210_01.1a Kalibrierschein").Range("C5") <> "" Then
                  '"Ende Abfrage ob Felder ausgefüllt"
                  If Sheets("F-210_01.1a Kalibrierschein").Range("F5") = "intern" Then
                     Const DateiPfad = "\\Q:\Qualitaet\AQP-Faist\10 Prüfmittelüberwachung\Kalibrierscheine\2016\" 'Achtung! Bitte das Jahr ggf. anpassen!
                     Dim DateiName As String
                     DateiName = DateiPfad & "FSKS-" & Format(Now, "yyyy-") & Range("B5") & ".pdf" ' Erzeugt einen interenen Kalibierschein als PDF (FSKS-Jahr-Kalibrierscheinnummer)
                     Range("A1:G49").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
                         DateiName, Quality:=xlQualityStandard, _
                         IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
                         True
                  Else
                     If Sheets("F-210_01.1a Kalibrierschein").Range("F5") = "extern" Then
                        DateiName = DateiPfad & "EXKS-" & Format(Now, "yyyy-") & Range("C5") & ".pdf" ' Erzeugt einen exterenen Kalibierschein als PDF (EXKS-Jahr-Kalibrierscheinnummer)
                        [color=#ffcc33]    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _[/color]
                        [color=#ffcc33]        DateiName, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _[/color]
                        [color=#ffcc33]        :=False, OpenAfterPublish:=True[/color]                        
                     Else
                        MsgBox "Es ist ein Fehler aufgetreten", vbCritical, "Achtung!"
                     End If
                  End If
               End If
            End If
         End If
      End If
   End If
   'Ende PDF erzeugen
End Sub 


---

Ich hoffe ihr könnt mir helfen.
Beste Grüße

[WillWissen]

Hallo WatchAroundQS,

auch wenn du Fehler gefunden hast, bitte ich dich, diesen hier als Lösung zu posten. Eventuell haben andere User ähnliche Probleme und würden sich freuen, über unsere Suchfunktion gleich eine Lösung angeboten zu bekommen.

@All

WatchAroundQS hat mittels Meldebutton darauf hingewiesen, dass er den Fehler selbst entdeckt hat.

[freddy]

Servus

Versuchs mal mit meinem Macro Du musst nur deine Datei namen anpassen
Funtioniert bei mit einwandfrei

Code:

Sub PDF_XLS_SICHERUNG_Spieltag()
 Logo = "© by manfredkefer@t-online.de 2009-" & Year(Now()) 
 Set AWS = ActiveSheet
 Jahr = Format(Date, "yyyy")
 MonatsNamenErmitteln
 
On Error GoTo errorhandler

      PDF_PFAD = "\PDF Dateien " & Year(Now) & "   "
      VerzeichnisPfad = ThisWorkbook.Path & PDF_PFAD & "Bundesliga Tipp"
      OrdnerName = PDF_PFAD & "Bundesliga Tipp"
     
      If Dir(VerzeichnisPfad, vbDirectory) <> "" Then
             MsgBox Space(32) & "Der Ordner" & vbNewLine & vbNewLine _
             & Space(18) & OrdnerName & vbNewLine & vbNewLine _
             & Space(26) & "ist bereits angelegt"
 
      Else
             Antwort = MsgBox(Space(28) & "Der Ordner " & vbNewLine & vbNewLine & _
             Space(8) & OrdnerName & vbNewLine & vbNewLine _
             & Space(22) & " ist nicht angelegt." _
             & vbNewLine & vbNewLine _
             & Space(10) & "soll der Ordner angelegt werden?!", vbYesNo)
errorhandler:
MsgBox Space(14) & "die Daten wurden nicht gesichert" & vbLf & vbLf & _
       Space(6) & "Bitte schliesen Sie die geöffnete PDF Datei"
Exit Sub

      If Antwort = vbYes Then
             MkDir VerzeichnisPfad
             
             MsgBox Space(24) & "Der Ordner " & vbNewLine & vbNewLine & _
                    Space(12) & OrdnerName & "  " & vbNewLine & vbNewLine & _
                    Space(24) & "wurde angelegt"
     
      Else
             MsgBox "Es wurden keine Änderungen vorgenommen"
      Exit Sub
     
      End If
      End If
 
 SpielTag_Seite_Einrichten
 
If MsgBox(Space(32) & "Möchten Sie Ihre Daten nun Sichern ?", vbYesNo, [Logo]) = vbNo Then Exit Sub

     If Month(Now) > 5 Then i = 0 Else i = 1
     If Month(Now) > 5 Then X = 1 Else X = 0
     
 ChDir VerzeichnisPfad

        DateiName = ActiveSheet.Name & "   Saison  " & Year(Now) - i & "-" & Year(Now) + X & ".pdf"
       
         ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
         DateiName, Quality:=xlQualityStandard, _
         IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
                                                                                             
     MsgBox Space(35) & "Ihre  Daten wurden im Unterordner " & vbLf & vbLf & _
            Space(36) & "Tippauswertung  " & ActiveSheet.Name & vbLf & vbLf & _
            Space(30) & "im PDF Format unter dem Dateinamen  " & vbLf & vbLf & _
            Space(38) & DateiName & vbLf & vbLf & _
            Space(54) & " gesichert", vbYes, [Logo]
End Sub

Sub Rangliste_Seite_Einrichten()
With ActiveSheet.PageSetup
       .PrintArea = "$B$1:$P$46"
       .LeftHeader = ""
       .CenterHeader = "&A      &D  "
       .RightHeader = ""
       .LeftFooter = "              © by manfredkefer@t-online.de 2015-" & Year(Now()) & " ® ™ + 49 (0) 171-199 84 94"
       .CenterFooter = "                                        http//www.mkefer.de"
       .RightFooter = ""
End With
   Application.PrintCommunication = True
End Sub

[schauan]

Hallöchen,

was mir gleich auffällt, sind die beiden Backslash vor dem Q:
Const DateiPfad = "\\Q: ...
Die gehören dort nur hin, wenn Du einen UNC-Pfad verwendest.

Dann muss natürlich der komplette Pfad vorhanden sein. Das kann ich aber von mir aus nicht prüfen

Bei der Verwendung von Zellwerten ist es zuweilen besser. mit .Value zu arbeiten, also
Range("B5").Value

[WillWissen]

Hi André,

ich glaube, das liest er nicht mehr. Das schrieb ich in Beitrag #2:

@All

WatchAroundQS hat mittels Meldebutton darauf hingewiesen, dass er den Fehler selbst entdeckt hat.

Unter anderem bat ich ihn, uns seine Lösung (Fehler) mitzuteilen.

[schauan]

Hallo Günter,

falls jemand bei der Suche auf diesen Thread stößt, hat er wenigstens einen Anhaltspunkt, wo ein Fehler liegen könnte.