Sauvegarde au format pdf par défaut

[Geely]

Bonjour le Forum

Pour une sauvegarde pratique je procède ainsi

Sub Sauvegarde_fichier() 'sauvegarde avec date
Application.Dialogs.Item(xlDialogSaveAs).Show arg1:="nom du fichier du " & Format(Date, "dddd d mmmm yyyy")
End Sub

Comment puis-je imposer l'extension du fichier .pdf

Geely

 

[camarchepas]

Re : Sauvegarde au format pdf par défaut

Bonjour ,

Sur XL 2003 , tu ne peux pas directement sauvegarder en pdf .

Changer l'extension peut être , mais ce ne sera toujours pas un pdf

Depuis 2007 , l'on peut le faire simplement ,

pour 2003 , il faudra passer par pdf creator je pense ou un équivalent

 

[Geely]

Re : Sauvegarde au format pdf par défaut

Bonsoir Camarche pas
OK pour 2003

Comment le faire alors si l'on est sur XL 2007.

Geely

 

[camarchepas]

Re : Sauvegarde au format pdf par défaut

Ok

donc 2007 et 2010 , voir 2013 :

ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF FileName:="sales.pdf" Quality:=xlQualityStandard DisplayFileAfterPublish:=True

 

[kiki29]

Re : Sauvegarde au format pdf par défaut

Salut, juste pour info 2003-

Option Explicit

Private Function GetPrinterWithPort(ByVal sPrinterName As String) As String
Dim Reg As Variant, oReg As Object, Str As Variant
Dim Ar() As Variant, RegValue As Variant
Const HKEY_CURRENT_USER = &H80000001
    Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
    With oReg
        .enumvalues HKEY_CURRENT_USER, "Software\Microsoft\Windows NT\CurrentVersion\Devices", Str, Ar
        .getstringvalue HKEY_CURRENT_USER, "Software\Microsoft\Windows NT\CurrentVersion\Devices", Reg, RegValue
        .getstringvalue HKEY_CURRENT_USER, "Software\Microsoft\Windows NT\CurrentVersion\Devices", sPrinterName, RegValue
    End With
    GetPrinterWithPort = sPrinterName & " sur " & Mid$(RegValue, InStr(RegValue, ",") + 1)
End Function

Sub Tst_PDF()
Dim sPrinter As String, sPDFPrinter As String
    sPrinter = Application.ActivePrinter

    sPDFPrinter = GetPrinterWithPort("PDFCreator")
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, ActivePrinter:=sPDFPrinter, Collate:=True
    
    Application.ActivePrinter = sPrinter
End Sub

 

[camarchepas]

Re : Sauvegarde au format pdf par défaut

Bonjour Geely, Kiki,

@ Merci Kiki

En effet , bien plus pratique pour 2003 avec ce petit bout de code.

Est-ce que l'on sait forcer le répertoire et le nom du fichier directement depuis le code ?

 

[Geely]

Re : Sauvegarde au format pdf par défaut

Bonjour Camarchepas & kiki29
Super, et pour 2003 le code est efficace.
Cela me rend un grand service.

 

[kiki29]

Re : Sauvegarde au format pdf par défaut

Salut, pour le nom et dossier de sauvegarde

Option Explicit

Private Function GetPrinterWithPort(ByVal sPrinterName As String) As String
Dim Reg As Variant, oReg As Object, Str As Variant
Dim Ar() As Variant, RegValue As Variant
Const HKEY_CURRENT_USER = &H80000001
    Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
    With oReg
        .enumvalues HKEY_CURRENT_USER, "Software\Microsoft\Windows NT\CurrentVersion\Devices", Str, Ar
        .getstringvalue HKEY_CURRENT_USER, "Software\Microsoft\Windows NT\CurrentVersion\Devices", Reg, RegValue
        .getstringvalue HKEY_CURRENT_USER, "Software\Microsoft\Windows NT\CurrentVersion\Devices", sPrinterName, RegValue
    End With
    GetPrinterWithPort = sPrinterName & " sur " & Mid$(RegValue, InStr(RegValue, ",") + 1)
End Function

Sub TstPdfCreator()
Dim JobPDF As Object
Dim sNomPDF As String
Dim sCheminPDF As String
Dim Ar() As String, i As Long
Dim sPrinter As String

    sNomPDF = "Essai"
    sCheminPDF = ThisWorkbook.Path & "\"
    sPrinter = GetPrinterWithPort("PDFCreator")

    Set JobPDF = CreateObject("PDFCreator.clsPDFCreator")
    JobPDF.cStart "/NoProcessingAtStartup"

    With JobPDF
        .cOption("UseAutosave") = 1
        .cOption("UseAutosaveDirectory") = 1
        .cOption("AutosaveDirectory") = sCheminPDF
        .cOption("AutosaveFilename") = sNomPDF
        .cOption("AutosaveFormat") = 0    ' PDF
        .cOption("PDFGeneralAutorotate") = 0
        .cClearCache
    End With

    For i = 1 To ThisWorkbook.Sheets.Count
        ReDim Preserve Ar(i - 1)
        Ar(i - 1) = Sheets(i).Name
    Next i
    
    Application.ScreenUpdating = False

    Sheets(Ar).Select
    Sheets(Ar).PrintOut copies:=1, ActivePrinter:=sPrinter

    ' Resélectionner une feuille seulement
    Worksheets(1).Select
    Erase Ar
    Application.ScreenUpdating = True
    DoEvents

    '   Fichier dans la file d'attente
    Do Until JobPDF.cCountOfPrintjobs = 1
        DoEvents
    Loop
    '   Démarrage Imprimante
    JobPDF.cPrinterStop = False

    '   Attendre que la file d'attente soit vide
    Do Until JobPDF.cCountOfPrintjobs = 0
        DoEvents
    Loop

    JobPDF.cClose
    Set JobPDF = Nothing
End Sub

Sinon voir le lien dans ma signature qui mène à une liste XLS exhaustive de mes contributions et téléchargements sur le sujet

 

[camarchepas]

Re : Sauvegarde au format pdf par défaut

Geely, Kiki

Merci pour le coup , j'ai tapé un peu l'intruste ,

C'est génial fonctionne comme une horloge, merci pour ce partage focalisé et sur l'ensemble de ta contribution, effectivement trés riche.