Clever-Excel-Forum

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

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.

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

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 Smile

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

Hi André,

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

Zitat:@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.

Hallo Günter,

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

WatchAroundQS

WillWissen

freddy

schauan

WillWissen

schauan