sauvegarder en pdf

[jmcr]

bonsoir le forum
voila mon problème je tente faire un macro avec un useforme pour sauvegarder mon dossier en pdf enfin avec le choix des feuille que je veux sauvegarder en pdf mais ma macro bug ligne en bleu j arrive pas a savoir je vous fournis le dossier en cause ou est l erreur pouvez vous m'aidé svp

avec tout ma gratitude
ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=MonRepertoire & "\" & [NomPDF] & " _ " & DateExtraction, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False

 

[kiki29]

Salut, si tu as une version Office < 2007 il te faudra un programme extérieur, du style PDFCreator 1.7.3, Adobe Acrobat etc .

 

[jmcr]

bonsoir kiki29 merci pour la reponse
non j ai excel 2003 Adobe Acrobatt il faut que je telecharge pdf Creator aussi pour mon macro

 

[kiki29]

Salut, quand je parle d'Acrobat il ne s'agit pas du Reader mais de la version payante d'Adobe Acrobat.
Après pour PDFCreator va ici

Il y a une liste qui permet, en principe, de naviguer dans le bazar pour les listings et Téléchargements.

 

[kiki29]

Salut, un exemple

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 sPrinter As String
Dim JobPDF As Object
Dim sNomPDF As String
Dim sCheminPDF As String
Dim Ar() As String, Cpt As Long, i As Long

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

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

    With JobPDF
        .cPrinterStop = True
        .cOption("UseAutosave") = 1
        .cOption("UseAutosaveDirectory") = 1
        .cOption("AutosaveDirectory") = sCheminPDF
        .cOption("AutosaveFilename") = sNomPDF

        '   0 PDF   1 PNG   2 JPEG  3 BMP       4 PCX       5 TIFF
        '   6 PS    7 EPS   8 TXT   9 PDF/A-2B  10 PDF/X    11 PSD
        '   12 PCL  13 RAW  14 SVG

        .cOption("AutosaveFormat") = 0
        .cOption("PDFGeneralAutorotate") = 0
        .cClearCache
    End With

    ' Pour n'imprimer que certaines feuilles du classeur
    Cpt = 0: Erase Ar
    For i = 1 To ThisWorkbook.Sheets.Count
        If Left$(ThisWorkbook.Sheets(i).Name, 6) = "Feuil1" Or _
           Left$(ThisWorkbook.Sheets(i).Name, 6) = "Feuil2" Then
            ReDim Preserve Ar(Cpt)
            Ar(Cpt) = Sheets(i).Name
            Cpt = Cpt + 1
        End If
    Next i

    If Cpt = 0 Then
        Set JobPDF = Nothing
        Exit Sub
    End If

    Application.ScreenUpdating = False
    Sheets(Ar).Select
    Sheets(Ar).PrintOut copies:=1, ActivePrinter:=sPrinter
    '    Sheets(Array("Feuil1", "Feuil2")).PrintOut copies:=1, ActivePrinter:=sPrinter
    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