XL 2016 Code VBA, Sauvegarde PDF un répertoire précis

[kingfadhel]

Je vous propose une code qui permet de sauvegarder sous forme de fichier pdf avec le le nom de l'onglet courant, dans un répertoire précis.

Private Sub Imprime1PDF()
Application.ScreenUpdating = False
'---Test existence du dossier de sauvegarde---
Call RépertoireExiste("c:\PDFS\")
Call RépertoireExiste("c:\PDFS\" & Year(Date))
Call RépertoireExiste("c:\PDFS\" & Year(Date) & "\RH")

'---Sauvegarde au format PDF dans le dossier ---
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
         "C:\PDFS\" & Year(Date) & "\RH\" & ActiveSheet.Name & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties _
        :=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
Application.ScreenUpdating = True
 End Sub

Function RépertoireExiste(Chemin As String) As Boolean
On Error Resume Next
RépertoireExiste = GetAttr(Chemin) And vbDirectory
    If RépertoireExiste = True Then
        Exit Function
    Else
        MkDir (Chemin)
    End If
End Function

 

[Staple1600]

Bonjour le fil, le forum, kingfahel

Et tu nous propose cela, sans nous dire Bonjour
Rhooo

Ceci dit merci pour l'intention

 

[Jacky67]

Bonjour à tous
Ou comme ceci
*Un peu plus court

Private Sub Imprime1PDF()
Dim Repertoire As String
Application.ScreenUpdating = False
'---Test existence du dossier de sauvegarde---
On Error Resume Next
MkDir "c:\PDFS\"
MkDir "c:\PDFS\" & Year(Date)
Repertoire = "c:\PDFS\" & Year(Date) & "\RH\": MkDir Repertoire
On Error GoTo 0
'---Sauvegarde au format PDF dans le dossier ---
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
Repertoire & ActiveSheet.Name, Quality:=xlQualityStandard, IncludeDocProperties _
:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
Application.ScreenUpdating = True
End Sub

 

[kiki29]

Salut, ici un autre datant de 2007 .....

 

[DoubleZero]

Bonjour à toutes et à tous,

Ou comme cela :

Option Explicit
Sub PDF_onglet_actif()
    Application.ScreenUpdating = False
    Dim nom As String, où As String
    nom = ActiveSheet.Name
    où = "C:\Users\DoubleZero\Downloads\"    ' adapter
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=où & nom & " - " & Format(Now(), "yyyy mm dd à hh-mm") & ".pdf"
    Application.ScreenUpdating = True
End Sub

A bientôt

 

[kingfadhel]

Bonjour le fil, le forum, kingfahel

Et tu nous propose cela, sans nous dire Bonjour
Rhooo

Ceci dit merci pour l'intention

Désolé, j'ai pas fais attention.
Et pour remédier à ça voilà un Bonjour en crédit (Samedi 11 Nov 2017 à 10:57) et un bonjour pour le Dim 12 Nov 2017 à 13:22 .