enregistrement PDF macro

flamilo

XLDnaute Junior
Bonjour j'ai beau je trouve différentes chose mais qui n'ont pas l'air de bien marcher :

Sub PDF1()
SaveFolder = "Bureau:Emilion:"
DocName = Range("E1").Value
FileExt = ".xlsx"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=SaveFolder & DocName, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
True
End Sub



Sub PDF2()
ActiveWindow.SelectedSheets.PrintOut Copies:=1, ActivePrinter:= _
"CutePDF Writer on CPW2:", Collate:=True
newHour = Hour(Now())
newMinute = Minute(Now())
newSecond = Second(Now()) + 2
waitTime = TimeSerial(newHour, newMinute, newSecond)
Application.Wait waitTime
Filename = "Bureau" & ActiveSheet.Range("E3").Value & "NS"

End Sub



Sub PDF3()
Dim Filename As String

With ActiveSheet
SaveFolder = "Mac HD:Emilion Pro"
Filename = .Range("E3")
.PrintOut Copies:=1, ActivePrinter:= _
"CutePDF Writer on CPW2:", Collate:=True

End With

End Sub

Je n'y connais vraiment rien en VBA alors j'essaye d'dapter ce que je trouve à ma situation mais ca ne fonctionne jamais... Je ne sais pas laquelle de ses macros peut marcher...

J'aimerai une macro qui m'enregistre la feuille que je choisie en pdf dans un dossier particulier..
Sinon je peut mettre un bouton pdf sur chacune de mes feuilles et enregistrer la feuille active, peu importe.
 

abtony

XLDnaute Impliqué
Re : enregistrement PDF macro

Bonsoir flamino, kiki29, le forum

voiçi tout prêt

a mettre dans un module et associer a un bouton (la deuxième procédure)

Premier code

VB:
Function MakePDF(TempPDFLocation As String, YourPDFfolder As String, YourPDFName As String, Finish As Boolean)
'Ron de Bruin, Version 2, 13-March-2012
'Function to create a PDF of the ActiveWorkbook in Excel 2011
'Note: The code will not work correct if not all sheets are the same type
'For example it will not work  if there is one chart sheet in the workbook
'If the sheets not all use landscape or portrait it is also not working correct
    Dim I As Long
    Dim SheetName As String
    Dim scriptToRun As String
    Dim ScriptToMakeDir As String

    If ActiveWorkbook.Sheets.Count > 1 Then
        'Script to create the Temporary PDF folder if it not exist
        ScriptToMakeDir = "tell application " & Chr(34) & _
                          "Finder" & Chr(34) & Chr(13)
        ScriptToMakeDir = ScriptToMakeDir & _
                          "do shell script ""mkdir -p "" & quoted form of posix path of " & _
                          Chr(34) & TempPDFLocation & Chr(34) & Chr(13)
        ScriptToMakeDir = ScriptToMakeDir & "end tell"

        On Error Resume Next
        MacScript (ScriptToMakeDir)
        On Error GoTo 0
    Else
        TempPDFLocation = YourPDFfolder
    End If

    'look for the first sheet name in the workbook
    'We need this name so we can remove it from the file name
    For I = 1 To ActiveWorkbook.Sheets.Count
        If Sheets(I).Visible = True Then
            SheetName = Sheets(I).Name
            Exit For
        End If
    Next I

    'Save the workbook as PDF, remove the sheet name from the file name(bug) and
    'move the PDF to YourPDFfolder if the workbook have more then one worksheet.
    scriptToRun = scriptToRun & "tell application " & Chr(34) & _
                  "Microsoft Excel" & Chr(34) & Chr(13)
    scriptToRun = scriptToRun & "save active workbook in (" & _
                  Chr(34) & TempPDFLocation & "TempName.pdf" & _
                  Chr(34) & ") as PDF file format" & Chr(13)
                  
    scriptToRun = scriptToRun & "end tell" & Chr(13)

    If Finish = True Then
        scriptToRun = scriptToRun & "tell application " & Chr(34) & _
                      "Finder" & Chr(34) & Chr(13)
        scriptToRun = scriptToRun & "set name of file " & Chr(34) & _
                      TempPDFLocation & "TempName " & SheetName & ".pdf" & Chr(34) & _
                    " to " & Chr(34) & YourPDFName & ".pdf" & Chr(34) & Chr(13)

        If ActiveWorkbook.Sheets.Count > 1 Then
            scriptToRun = scriptToRun & "move " & Chr(34) & TempPDFLocation _
                        & YourPDFName & ".pdf" & Chr(34) & " to " & Chr(34) & YourPDFfolder & Chr(34) & Chr(13)
        End If
        scriptToRun = scriptToRun & "end tell" & Chr(13)
    End If

    On Error Resume Next
    MacScript (scriptToRun)
    On Error GoTo 0
End Function

Deuxième code a placer dans un module

VB:
 Sub CreatePDFSheet()
'Ron de Bruin, 1-June-2012
    Dim TempPDFFolder As String
    Dim PDFfolder As String
    Dim PDFfileName As String
   
    'Path to folder where we save the pdf's temporary. The code will create
    'the folder named "PDFTempFolder" in your Documents folder for you
    'Note: this will not be used when you create a pdf of one sheet but not remove this line
    TempPDFFolder = MacScript("return (path to documents folder) as string") & "PDFTempFolder:"


    'Folder where you want to save the PDF file, Documents folder in this example
    'PDFfolder = MacScript("return (path to documents folder) as string")

'''''''Ici tu active cette ligne si tu veux avoir le choix du dossier et tu désactive celle du dessous
'PDFfolder = MacScript("choose folder as string")

'''''''Personalisé le dossier ou sera enregistré le PDF  --> celui ci est le miens en exemple
PDFfolder = "Machintoch HD:Users:ton user:Documents:Factures:"

    'Enter the file name that you want to use for the PDF, do not add the extension.
    '''''''''' La personalise les information du classeur a enregistré ---> comme ci dessous
   PDFfileName = Worksheets("Facture").Range("NomClient") & " " & "Facture" & " " & Range("NumFact") & " " & "Du" & " " & Range("DateFact") 'Format(Now, "dd/mmm/yyyy")

    Application.ScreenUpdating = False

    'You can also use this for the activesheet : ActiveSheet.Copy
    
   ''''''Ici indiqué la feuille a créée en PDF 
   Worksheets("Facture").Copy

    'Do not change the macro call below, you see that we only have one macro call
    'if we create a PDF of one sheet because we not have a problem with the bug that
    'create a pdf of each worksheet in the workbook because there is only one sheet.
    Call MakePDF(TempPDFFolder, PDFfolder, PDFfileName, True)

    'Close temporary file
    ActiveWorkbook.Close SaveChanges:=False

    Application.ScreenUpdating = True
End Sub

A la sortie le PDF sera lourd, il faut donc créée une action dossier dans automator et mettre en action (Filtre Quartz
et dans filtre choisir (Reduce File Size)) et enregistrer l'action automator en prenant soin de choisir le dossier Factures (pour le miens bien sur a toi de choisir en fonction de ton besoin)

Cordialement abtony

J'ai passer trois soirée a chercher et modifier ce code a ma sauce, pour tout dire je viens juste de finir ;)

Bon profit il fonctionne très bien.
 
Dernière édition:

Discussions similaires

Réponses
3
Affichages
473

Statistiques des forums

Discussions
311 725
Messages
2 081 943
Membres
101 849
dernier inscrit
florentMIG