Macro Excel-tab opslaan als PDF

[tomswaelen]

Ik heb een macro opgenomen waarmee ik een tab uit mijn Excel opsla als PDF op mijn bureaublad. Werkt perfect, maar deze zou ook door andere mensen gebruikt moeten worden, en het pad naar hun bureaublad verschilt natuurlijk. Dus wil ik de macro gewoon laten vragen waar ze de PDF willen opslaan, dat is in feite nog meer gebruiksvriendelijk.

Hoe pas ik deze macro aan zodat Excel komt vragen waar hij de PDF moet opslaan?

Sub PDF()
'
' PDF Macro
'

'
    Sheets("Afdrukken").Select
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        "C:\Users\SWTO.CORPARG\Desktop\Overschrijving.pdf", Quality:=xlQualityMinimum _
        , IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
        False
    Sheets("Ingeven").Select
End Sub

 

[HSV]

Zo zo het moeten lukken om naar elk willekeurig bureaublad weg te schrijven.

Sub PDF()
'
' PDF Macro
'
'
    Sheets("Afdrukken").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
       [COLOR=#ff0000]Environ("USERPROFILE") & "\Desktop\Overschrijving.pdf", [/COLOR]Quality:=xlQualityMinimum _
        , IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
        False
    Sheets("Ingeven").Select
End Sub

 

[tomswaelen]

Dat lijkt te werken. En hoe moet ik de code aanpassen als ik Excel naar de locatie wil laten vragen? Of maw: de Save As dialog box laten zien.

 

[edmoor]

Dat kan met een simpele functie:

Private Function KiesMapnaam()

    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        .Show
        On Error Resume Next
        KiesMapnaam = .SelectedItems(1)
        Err.Clear
        On Error GoTo 0
    End With

End Function

Plaats deze in een module.

Aanroep:
Mapnaam = KiesMapnaam()

In de code van HSV vervang je dan Environ("USERPROFILE") door Mapnaam.

 

[HSV]

Mooie functie @edmoor :thumb:,

Het staat alweer zonder enige reactie op opgelost (beetje jammer van het idee van een forum).
Code van jou iets aangepast voor meer functionaliteit.

Private Function KiesMapnaam()
    With Application.FileDialog(msoFileDialogSaveAs)
        .AllowMultiSelect = False
        .InitialFileName = "Overschrijvingen 3"
        .FilterIndex = 25
        .Show
    On Error Resume Next
        KiesMapnaam = .SelectedItems(1)
        Err.Clear
        On Error GoTo 0
    End With
End Function

Ook de volledige aanroep er maar bij gedaan voor andere gebruikers.

Sub PDF()
Dim Mapnaam As String
Mapnaam = KiesMapnaam()
 Sheets("Afdrukken").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
 Mapnaam, Quality:=xlQualityMinimum _
        , IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
        False
End Sub

 

[edmoor]

Het staat alweer zonder enige reactie op opgelost (beetje jammer van het idee van een forum).

Helemaal mee eens.
Gelukkig zijn de meesten wel zo attent om even te reageren als het probleem opgelost is.

Ik mis nu overigens wel een bestandsnaam in je onderste code

 

[HSV]

edmoor,

bestandsnaam = .InitialFileName = "Overschrijvingen 3"
die jezelf nog kan wijzigen.

Mapnaam kan je zelf kiezen.

 

[edmoor]

Ok, ik had even niet in de gaten dat je de Folderpicker had veranderd in SaveAs.
My bad, ik had beter moeten weten

Je kunt dan ook de InitialFileName als parameter mee geven, wat 'm dan nog flexibeler maakt:

Private Function KiesMapnaam(IniFilename)
    With Application.FileDialog(msoFileDialogSaveAs)
        .AllowMultiSelect = False
        .InitialFileName = IniFilename
        .FilterIndex = 25
        .Show
    On Error Resume Next
        KiesMapnaam = .SelectedItems(1)
        Err.Clear
        On Error GoTo 0
    End With
End Function

 

[HSV]

Ha, je hebt je reactie aangepast zie ik.

Mooie aanvulling @edmoor.