vba Save_Excel_As_PDF met Application.GetSaveAsFilename maar filename uitgrijzen

[tonissteiner]

Hallo forumgebruikers,

ik heb volgende perfect werkende code:

Sub Save_Excel_As_PDF()

    Dim PdfFilename As Variant

    PdfFilename = Application.GetSaveAsFilename( _
        InitialFileName:=Sheets("Identification Plate & CE-label").[D6].Value & " - " & [D20].Value & " - " & "CE plate", _
        FileFilter:="PDF, *.pdf", _
        Title:="Save As PDF")

    If PdfFilename = False Then Exit Sub

        ActiveSheet.ExportAsFixedFormat _
            Type:=xlTypePDF, _
            Filename:=PdfFilename, _
            Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, _
            OpenAfterPublish:=False

    MsgBox "Done! Saved as:" & vbCrLf & _
    PdfFilename & vbCrLf & _
    "" & vbCrLf & _
    "Excel will be closed!", vbInformation, "FILE SAVED"

    ThisWorkbook.Saved = True
    Application.Quit

End Sub

Nu zou ik graag hebben dat de filename niet meer gewijzigd kan worden, uitgegrijsd wordt met andere woorden.

Weet iemand of dit kan ik deze code of moet er gewerkt worden via bijvoorbeeld FileDialogFolderPicker?

Zo ja, kan ik wel wat hulp gebruiken over het gebruik van de FileDialogFolderPicker.


Alvast bedankt voor jullie reacties

 

[edmoor]

Je kan deze gebruiken voor het selecteren van een folder:

Sub SelecteerMapnaam()
    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = "C:\"
        .Title = "Selecteer maplocatie"
        .ButtonName = .Title
        .Show
        If .SelectedItems.Count > 0 Then
            Sheets("Blad1").Range("A1") = .SelectedItems(1)
        End If
    End With
End Sub

 

[snb]

of

Sub M_snb()
    With Application.FileDialog(4)
        .InitialFileName = "G:\OF\"
        .Title = "Selecteer maplocatie"
        .ButtonName = .Title
        If .Show Then Blad1.Cells(1) = .SelectedItems(1)
    End With
End Sub

 

[tonissteiner]

Bedankt voor deze codes Edmoor en Snb,

heb deze geprobeerd en werken prima.

Zelf had ik deze code nog samengesteld. Echter bij het indrukken van de Cancel knop wanneer het venster verschenen is wordt de messagebox toch weergegeven.

Kunnen jullie een tip geven hoe ik de sub gewoon verlaat bij Cancel?

Sub Save_as_PDF()

    Dim Pad As String, BestandsNaam As String

    Pad = GetFolder + "\"

    BestandsNaam = Sheets("Identification Plate & CE-label").[D6].Value & " - " & [D20].Value & " - " & "CE plate"

    Sheets("Identification Plate & CE-label").ExportAsFixedFormat Type:=xlTypePDF, Filename:=Pad & BestandsNaam, Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

    MsgBox "Done! Saved as:" & vbCrLf & _
    Pad & BestandsNaam & ".pdf" & vbCrLf & _
    "" & vbCrLf & _
    "Excel will be closed!", vbInformation, "FILE SAVED"

    'ThisWorkbook.Saved = True
    'Application.Quit

End Sub

Function GetFolder() As String

    Dim fldr As FileDialog

    Dim sItem As String

    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)

    With fldr
        .Title = "Select a Folder Where You Want to Save Your PDF"
        .AllowMultiSelect = False
        .ButtonName = "Select Location"

        If .Show <> -1 Then GoTo NextCode
        sItem = .SelectedItems(1)
    End With

NextCode:
    GetFolder = sItem

    Set fldr = Nothing

End Function

 

[edmoor]

Nooit GoTo gebruiken!

Sub edm()
    Dim sItem As String
    
    sItem = GetFolder
    If sItem <> "" Then
        Debug.Print sItem
    Else
        Debug.Print "Geannuleerd"
    End If
End Sub

Function GetFolder() As String
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Select a Folder Where You Want to Save Your PDF"
        .AllowMultiSelect = False
        .ButtonName = "Select Location"
        If .Show Then GetFolder = .SelectedItems(1)
    End With
End Function

Tips:
Gebruik hier geen + maar &
Pad = GetFolder + "\"

Je verwijst hier naar 2 sheets, [D6] op het blad "Identification Plate & CE-label" en [D20] op het actieve blad.
Dat kan in dit geval juist zijn maar kan dus net zo goed fout zijn:
BestandsNaam = Sheets("Identification Plate & CE-label").[D6].Value & " - " & [D20].Value & " - " & "CE plate"

 

[tonissteiner]

Bedankt voor de tip en de code Edmoor,

werkt perfect.

Voor de volledigheid en voor wie deze code ook wilt gebruiken (let op "sItem" is "Locatie" geworden en heb "Identification Plate & CE-label" hernoemd naar "Sheet1" om de code universeler te maken).
De debug heb ik ook laten staan voor eventueel andere gebruikers.

Belangrijk voor wie de code wilt kopiëren, let op de "Application.Quit" ergens onderaan de code waarmee Excel zal afgesloten worden! Je eventuele wijzigingen gaan verloren.

Sub Save_as_PDF()

    Dim BestandsNaam As String, Locatie As String
    
    Locatie = GetFolder

    If Locatie <> "" Then
        Debug.Print sItem
        BestandsNaam = Sheets("Sheet1").[D6].Value & " - " & [D20].Value & " - " & "CE plate"

        Sheets("Sheet 1").ExportAsFixedFormat Type:=xlTypePDF, Filename:=Locatie + "\" & BestandsNaam, Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

        MsgBox "Done! Saved as:" & vbCrLf & _
            Locatie + "\" & BestandsNaam & ".pdf" & vbCrLf & _
            "" & vbCrLf & _
            "Excel will be closed!", vbInformation, "FILE SAVED"
    
    Else
        MsgBox "Canceled by user", vbInformation, "SAVE AS PDF"
        Debug.Print "Geannuleerd"
    
    End If

    ThisWorkbook.Saved = True
    Application.Quit

End Sub

Function GetFolder() As String
    
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Select a Folder Where You Want to Save Your PDF"
        .AllowMultiSelect = False
        .ButtonName = "Select Location"
        If .Show Then GetFolder = .SelectedItems(1)
    End With

End Function

 

[edmoor]

Daar zit dus nog hetzelfde probleem met de sheetnaam in. Als BestandsNaam uit D6 en D20 moet komen uit Sheets(Sheet1"), gebruik dan dit:

With Sheets("Sheet1")
    BestandsNaam = .[D6].Value & " - " & .[D20].Value & " - " & "CE plate"
End With

Overigens gebruik je ook nog steeds + waar & gebruikt moet worden.
De + is voor berekeningen en de & om strings aan elkaar te plakken.

 

[tonissteiner]

Wat bedoel je precies met je tip Edmoor?

Gebruik hier geen + maar &
Pad = GetFolder + ""

is het dan (rekening houdend dat ik Pad weggelaten heb en sItem hernoemd heb in Locatie):

Locatie = GetFolder + ""
Locatie = GetFolder & ""
Locatie = GetFolder + ""
Locatie = GetFolder & ""

of zijn ze allemaal goed?

Zoals je ziet in mijn code heb ik + "" verder in mijn code moeten zetten. Zoals het origineel stond in mijn eerste post Pad = GetFolder + "" kreeg ik de messagebox ook bij Cancel

 

[tonissteiner]

Ja sorry, onze berichten hebben elkaar gekruist. Was bericht aan het typen toen jij het jouwe postte.

 

[edmoor]

De + wordt getolereerd voor het aan elkaar plakken van strings wegens compatibiliteit met heel oude VBA versies.
Als men bij Microsoft besluit die compatibiliteit niet meer te ondersteunen heb je ineens een probleem.

 

[tonissteiner]

Okido, bedankt en snap het. Nogmaals bedankt voor je tips.

Heb mijn code aangepast met je tips.

 

[snb]

Berichtenvensters zijn voor mensen die niet geloven dat iets geautomatiseerds kan werken.
Ze zijn allemaaal overbodig.
Dat geldt ook voor parameters die als defaultwaarden overeenkomen met je bedoeling.
Vermijd overbodige variabelen.
Vermijd exotische tekens (vooral spaties) in bestandsnamen: [D6] & "_" & [D20] & "_CE plate"

Sub M_snb()
    With Application.FileDialog(4)
        .InitialFileName = "G:\OF\"
        .Title = "Selecteer maplocatie"
        .ButtonName = .Title
        if .Show then activesheet.exportasfixedformat 0, .SelectedItems(1) & "\voorbeeld.pdf"
    End With
End Sub

 

[tonissteiner]

Ik ben het met je eens SNB, jammer genoeg werken we met mensen van verschillend allooi en zijn die berichtenvensters soms noodzakelijk. Er zijn mensen die denken dat Excel een simpele rekenmachine is en dat automatiseren enkel kan in SiFi films.

Dit is ook een reden waarom ik alle tekst in het Engels moet zetten. Spaties en exotische tekens ben ik me van bewust, ook al veel problemen met gehad. Ze willen echter een uniforme naam toepassen voor alle documenten. Zowel, Wordt, Excel, PDF, ...
en dus allemaal met spaties en koppeltekens ertussen.