Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1556to1560
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

PDF speichern, Duplikate auffangen

PDF speichern, Duplikate auffangen
16.05.2017 08:25:06
Nati
Guten Morgen,
habe einen Code in dem der User den Zielort auswählen kann, wo die Excel Datei als PDF gespeichert wird, logischerweise werden Dateien mit dem gleichen Namen nicht gespeichert, das Problem ist, dass bis dato das dem User nicht ersichtlich wird, dass er den Dateinamen umändern muss.
Wäre sehr dankbar wenn mir da jemand behilflich sein kann.
Private Sub Button_SAVE_Click()
On Error GoTo err_fehler1 --> Habe es damit versucht, aber der Fehler kommt immer...
Dim strName As String
Dim strDate As String
Dim response As Variant
Dim question As Variant
Dim sPath
'format date YYYY-MM-DD
strDate = Worksheets("Verification Form").Range("Datum").Value
strDate = Format(strDate, "yyyy-mm-dd")
' Aktiviert die zu speichernden Sheets -> die anderen ausblenden
'Bei Klick in die Checkboxen des Formulars PDF_ALL
If CheckBox_Verification = False Then        '---Verification Form
Worksheets("Verification Form").Visible = False
Else:  Worksheets("Verification Form").Visible = True
End If
If Checkbox_Verification_Details = False Then    '--- Verification Form Details
Worksheets("Verification Form Details").Visible = False
Else: Worksheets("Verification Form Details").Visible = True
End If
' Dateibezeichner: Datum_R@R_Lieferant
strName = strDate & "_R@R_" & "_" & Worksheets("Verification Form").Range("SupplierName"). _
Value
' Speichern des R@R als PDF mit dem Dateibezeichner
sPath = Application.GetSaveAsFilename(InitialFileName:=Environ("USERPROFILE") & "\Documents\" _
_
& strName, _
FileFilter:="PDF-Datei (*.pdf),*.pdf")
question = MsgBox("Do you want to see the saved pages?", vbYesNo + vbInformation)
If question = vbYes Then
ThisWorkbook.ExportAsFixedFormat xlTypePDF, Filename:= _
sPath, Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=True
' Rückmeldung dass Speichern erfolgreich
response = MsgBox("The File was sucessfull saved", vbOKOnly + vbInformation)
Else
ThisWorkbook.ExportAsFixedFormat xlTypePDF, Filename:= _
sPath, Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False
' Rückmeldung dass Speichern erfolgreich
response = MsgBox("The File was sucessfull saved", vbOKOnly + vbInformation)
End If
PDF_ALL.Hide ' Ausblenden des Dialogs "Speichern/Drucken"
'-----Aktiviert beim Beenden des Dialogs wieder alle relevanten Sheets
Worksheets("Verification Form").Visible = True
Worksheets("Verification Form Details").Visible = True
Worksheets("Questionnaire").Visible = True
Worksheets("Calculation").Visible = True
Worksheets("Action Log").Visible = True
Worksheets("Introduction").Visible = True 'RB: nach dem Druck wieder einblenden
Worksheets("Calc Example").Visible = True 'RB: nach dem Druck wieder einblenden
'Go back to start page
Sheets("Verification Form").Select
Range("D3").Select
err_fehler1:
MsgBox "Error-Code: err_code_1 " & vbCrLf & "Error no.: " & Err.Number & _
vbCrLf & "Error description: " & Err.Description
End Sub
Sollte ich da ggf noch andere Abfragen machen? ( als zusatz)
LG Nati

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: PDF speichern, Duplikate auffangen
16.05.2017 09:56:21
UweD
Hallo
so?
Private Sub Button_SAVE_Click()

    On Error GoTo err_fehler1 ' --> Habe es damit versucht, aber der Fehler kommt immer... 
      
    Dim strName As String
    Dim strDate As String
    Dim response As Variant
    Dim question As Variant
    Dim sPath As Variant
    Dim booSee As Boolean
    
    
    'format date YYYY-MM-DD 
    strDate = Worksheets("Verification Form").Range("Datum").Value
    strDate = Format(strDate, "yyyy-mm-dd")
    
    ' Aktiviert die zu speichernden Sheets -> die anderen ausblenden 
      'Bei Klick in die Checkboxen des Formulars PDF_ALL 
        
    If CheckBox_Verification = False Then        '---Verification Form 
        Worksheets("Verification Form").Visible = False
    Else: Worksheets("Verification Form").Visible = True
    End If

    If Checkbox_Verification_Details = False Then    '--- Verification Form Details 
        Worksheets("Verification Form Details").Visible = False
    Else: Worksheets("Verification Form Details").Visible = True
    End If
         
    ' Dateibezeichner: Datum_R@R_Lieferant 
    strName = strDate & "_R@R_" & "_" & Worksheets("Verification Form").Range("SupplierName").Value
    
    sPath = Environ("USERPROFILE") & "\Documents\" & strName
        
    
    ' Speichern des R@R als PDF mit dem Dateibezeichner 
    sPath = Application.GetSaveAsFilename(InitialFileName:= _
        sPath, FileFilter:="PDF-Datei (*.pdf),*.pdf")
    
    ' Prüfen, ob Datei schon da 
    Do Until Dir(sPath) = ""
        sPath = InputBox("Enter new Filename!", "File already exist!", sPath)
    Loop
                                        
    question = MsgBox("Do you want to see the saved pages?", vbYesNo + vbInformation)
     
    booSee = (question = vbYes)

    ThisWorkbook.ExportAsFixedFormat xlTypePDF, Filename:= _
        sPath, Quality:= _
        xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
        OpenAfterPublish:=booSee
    
    ' Rückmeldung dass Speichern erfolgreich 
    response = MsgBox("The File was sucessfull saved", vbOKOnly + vbInformation)
            
     
    PDF_ALL.Hide ' Ausblenden des Dialogs "Speichern/Drucken" 
    '-----Aktiviert beim Beenden des Dialogs wieder alle relevanten Sheets 
     
    Worksheets("Verification Form").Visible = True
    Worksheets("Verification Form Details").Visible = True
    Worksheets("Questionnaire").Visible = True
    Worksheets("Calculation").Visible = True
    Worksheets("Action Log").Visible = True
    Worksheets("Introduction").Visible = True 'RB: nach dem Druck wieder einblenden 
    Worksheets("Calc Example").Visible = True 'RB: nach dem Druck wieder einblenden 
    
    
      
    'Go back to start page 
    Sheets("Verification Form").Select
    Range("D3").Select
    
         
err_fehler1:
    If Err.Number <> 0 Then
        MsgBox "Error-Code: err_code_1 " & vbCrLf & "Error no.: " & Err.Number & _
            vbCrLf & "Error description: " & Err.Description
        Err.Clear
    End If

End Sub

LG UweD
Anzeige
AW: PDF speichern, Duplikate auffangen
16.05.2017 10:43:49
Nati
Hallo Uwe,
vielen Dank genau das habe ich gesucht!,
Gibt es denn eine Möglichkeit, dass falls der User doch keine neue Datei speichern will,( bei der Fehlermeldung , dass Datei schon existiert), dass sich die Sub dann schließt, denn man hat dort die Möglichkeit einen neuen Dateinamen einzugeben oder auf "Abbrechen" zu klicken.
Wenn man auf "Abbrechen" klickt erscheint das Feld zur Eingabe eines neuen Dateinamens aber immer wieder wahrscheinlich wegen dem Loop?
' Prüfen, ob Datei schon da
Do Until Dir(sPath) = ""
sPath = InputBox("Enter new Filename!", "File already exist!", sPath)
Loop
Viele liebe Grüße, Nati
Anzeige
AW: PDF speichern, Duplikate auffangen
16.05.2017 11:09:34
UweD
dann so...
Private Sub Button_SAVE_Click()

    On Error GoTo err_fehler1 ' --> Habe es damit versucht, aber der Fehler kommt immer... 
      
    Dim strName As String
    Dim strDate As String
    Dim response As Variant
    Dim question As Variant
    Dim sPath As Variant
    Dim booSee As Boolean
    
    
    'format date YYYY-MM-DD 
    strDate = Format(Worksheets("Verification Form").Range("Datum").Value, "yyyy-mm-dd")
    
    ' Aktiviert die zu speichernden Sheets -> die anderen ausblenden 
      'Bei Klick in die Checkboxen des Formulars PDF_ALL 
        
    Worksheets("Verification Form").Visible = CheckBox_Verification
    
    Worksheets("Verification Form Details").Visible = Checkbox_Verification_Details
         
    ' Dateibezeichner: Datum_R@R_Lieferant 
    strName = strDate & "_R@R_" & "_" & Worksheets("Verification Form").Range("SupplierName").Value
    
    sPath = Environ("USERPROFILE") & "\Documents\" & strName
        
    
    ' Speichern des R@R als PDF mit dem Dateibezeichner 
    sPath = Application.GetSaveAsFilename(InitialFileName:= _
        sPath, FileFilter:="PDF-Datei (*.pdf),*.pdf")
    
    ' Prüfen, ob Datei schon da 
    Do Until Dir(sPath) = ""
        sPath = InputBox("Enter new Filename!", "File already exist!", sPath)
        If sPath = "" Then
            response = MsgBox("The File was NOT saved", vbOKOnly + vbInformation)
            Exit Sub
        End If
    Loop
                                        
    booSee = MsgBox("Do you want to see the saved pages?", vbYesNo + vbInformation) = vbYes
     

    ThisWorkbook.ExportAsFixedFormat xlTypePDF, Filename:= _
        sPath, Quality:= _
        xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
        OpenAfterPublish:=booSee
    
    ' Rückmeldung dass Speichern erfolgreich 
    response = MsgBox("The File was sucessfull saved", vbOKOnly + vbInformation)
            
     
    PDF_ALL.Hide ' Ausblenden des Dialogs "Speichern/Drucken" 
    '-----Aktiviert beim Beenden des Dialogs wieder alle relevanten Sheets 
     
    Worksheets("Verification Form").Visible = True
    Worksheets("Verification Form Details").Visible = True
    Worksheets("Questionnaire").Visible = True
    Worksheets("Calculation").Visible = True
    Worksheets("Action Log").Visible = True
    Worksheets("Introduction").Visible = True 'RB: nach dem Druck wieder einblenden 
    Worksheets("Calc Example").Visible = True 'RB: nach dem Druck wieder einblenden 
    
    
      
    'Go back to start page 
    Sheets("Verification Form").Select
    Range("D3").Select
    
         
err_fehler1:
    If Err.Number <> 0 Then
        MsgBox "Error-Code: err_code_1 " & vbCrLf & "Error no.: " & Err.Number & _
            vbCrLf & "Error description: " & Err.Description
        Err.Clear
    End If

End Sub


LG UweD
Anzeige
AW: PDF speichern, Duplikate auffangen
16.05.2017 13:02:30
Nati
Hallo Uwe,
excellent, Dankeschön.
LG Nati
AW: gern geschehen owt
16.05.2017 13:24:47
UweD
AW: PDF speichern, Duplikate auffangen
16.05.2017 10:13:42
Michael
Hallo Nati!
Evtl. könnte man den Code auch etwas aufräumen:
Private Sub Button_SAVE_Click()
Dim strName$, strDate$, strPath$, strDatei$
Dim Check As Boolean
Check = False
strDate = Format(Worksheets("Verification Form").Range("Datum").Value, "yyyy-mm-dd")
Worksheets("Verification Form").Visible = CheckBox_Verification.Value
Worksheets("Verification Form Details").Visible = Checkbox_Verification_Details.Value
strName = strDate & "_R@R_" & "_" & Worksheets("Verification Form").Range("SupplierName"). _
Value
strPath = Application.GetSaveAsFilename(InitialFileName:=Environ("USERPROFILE") & _
"\Documents\" & strName, FileFilter:="PDF-Datei (*.pdf),*.pdf")
Do Until Dir(strPath) = ""
strPath = Application.GetSaveAsFilename(InitialFileName:=Environ("USERPROFILE") & _
"\Documents\" & strName, FileFilter:="PDF-Datei (*.pdf),*.pdf")
Loop
If MsgBox("Do you want to see the saved pages?", vbYesNo + vbInformation) = vbYes Then  _
Check = True
ThisWorkbook.ExportAsFixedFormat xlTypePDF, Filename:=strPath, Quality:=xlQualityStandard,  _
_
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=Check
MsgBox "File sucessfully saved", vbOKOnly + vbInformation
PDF_ALL.Hide
Worksheets("Verification Form").Visible = True
Worksheets("Verification Form Details").Visible = True
Worksheets("Questionnaire").Visible = True
Worksheets("Calculation").Visible = True
Worksheets("Action Log").Visible = True
Worksheets("Introduction").Visible = True
Worksheets("Calc Example").Visible = True
Sheets("Verification Form").Select
Range("D3").Select
End Sub
Ansonsten ist meine Methode beim Dateinamen analog zu jener von Uwe.
LG
Michael
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige