imprimer un pdf crée par excel

[pascal21]

Sub copiePDF1() 'code copie en PDF et classement

Dim sNomDossier As String
Dim sNomFichierPDF As String


    sNomDossier = ThisWorkbook.Path
    sNomFichierPDF = " Devis N° " & Feuil2.Range("b16") & " du " & Format(Feuil2.Range("b17"), " dd mmmm yyyy") & " " & Feuil2.Range("d4") & " " & Feuil2.Range("d6")
    
     sNomDossier = ThisWorkbook.Path & "\année 2013\" & Format(Feuil2.Range("b17"), "mmmm yyyy") & "\"
     
     
    If Len(sNomFichierPDF) > 0 Then
        If NomFichierValide(sNomFichierPDF) Then
            ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
                                            Filename:=sNomDossier & "/" & _
                                                      sNomFichierPDF & ".pdf" _
                                                      , Quality:=xlQualityStandard, _
                                            IncludeDocProperties:=True, _
                                            IgnorePrintAreas:=False, _
                                            OpenAfterPublish:=False
        Else
            Feuil2.Range("b17").Select
            MsgBox "Nom de fichier invalide", vbOKOnly + vbInformation, "Nom de Fichier"
        End If
    End If
  MsgBox ("Le fichier PDF nommé " & sNomFichierPDF & " à bien été crée dans le répertoire " & sNomDossier)
  
End Sub
'suite code copie PDF1
Private Function NomFichierValide(sChaine As String) As Boolean
Dim i As Long
Const CaracInterdits As String = """*/:<>?[\]|"


    NomFichierValide = True
    For i = 1 To Len(CaracInterdits)
        If InStr(sChaine, Mid$(CaracInterdits, i, 1)) > 0 Then
            NomFichierValide = False
            Exit Function
        End If
    Next i
End Function

bonsoir
ce code me permet de créer un pdf et de le classer dans un dossier par date
je cherche à avoir la possibilité d'imprimer ce pdf depuis ce code
l'idée est d'inclure dans le Msgbox indiquant que le dossier pdf à bien été crée, une question pour savoir si l'utilisateur veut imprimer ce fichier maintenant ou pas
comment réaliser ceci
merci

 

[yassoux]

Re : imprimer un pdf crée par excel

Bonjour pascal21,

concernant le lancement d’impression, tu peux essayer de le faire en record macro ? tu verra la code qui en résulte et pourra le modifier ?

concernant ta demande d'inclure une question dans ton message Box, tu peux essayer ceci :

reponse = MsgBox ("Le fichier PDF nommé " & sNomFichierPDF & " à bien été crée dans le répertoire " & sNomDossier & Chr(10) & "Voulez vous imprimer le document ?", vbYesNo )

If reponse = vbYes Then
          'ton code pour l'impression
Else
          'ton code pour annuler
End If

j'espère que cela t'aideras !?

 

[pascal21]

Re : imprimer un pdf crée par excel

bonsoir Yasoux

'ton code pour l'impression

justement ç'est ça qui me manque en fait
je vais essayer en enregistrement macro mais je ne suis pas sur que cela fonctionne
edit: c'est ce qui me semblait l'enregistreur ne prend pas les commandes sur des fichiers non excel

 

[yassoux]

Re : imprimer un pdf crée par excel

Bonjour pascal21,

je pense que j'avais mal compris ton soucis ...
tu peux peut être regarder de ce coté là : https://www.excel-downloads.com/threads/impression-dun-fichier-pdf-via-vba.134518/
l'idée d'envoyer des touches de raccourci est vraiment pas bête !

Bon courage !

 

[stefan373]

Re : imprimer un pdf crée par excel

Bonjour pascal21, yassoux et le forum,

Si cela vous intéresse toujours, voici un code bidouiller qui fonctionne chez moi.
Mais, car il y a toujours un mais, il vous faudra modifier le chemin pour accéder à Adobe Reader car probablement pas le même que moi. De plus, il y a un petit défaut, la touche NumLock se déverrouille à cause du SendKeys.

Option Explicit
Private Declare Function FindWindow& Lib "user32" Alias "FindWindowA" ( _
  ByVal lpClassName As String, ByVal lpWindowName As String)
Private Declare Function PostMessage& Lib "user32" Alias "PostMessageA" ( _
  ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long)
Declare Function ShellExecute& Lib "shell32.dll" Alias "ShellExecuteA" ( _
  ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
  ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long)
 
Private Const WM_CLOSE = &H10
Sub copiePDF1() 'code copie en PDF et classement
Dim sNomDossier As String
Dim sNomFichierPDF As String
Dim PDFFilename As String
Dim impression As String
Dim x
Dim Hdl&
Dim Rep&
Dim acrobat

    sNomDossier = ThisWorkbook.Path
    sNomFichierPDF = " Devis N° " & Feuil2.Range("b16") & " du " & Format(Feuil2.Range("b17"), " dd mmmm yyyy") & " " & Feuil2.Range("d4") & " " & Feuil2.Range("d6")
    sNomDossier = ThisWorkbook.Path & "\test\" & Format(Feuil1.Range("a2"), "mmmm yyyy") & "\"
    If Len(sNomFichierPDF) > 0 Then
        If NomFichierValide(sNomFichierPDF) Then
            ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
                                            Filename:=sNomDossier & _
                                                      sNomFichierPDF & ".pdf" _
                                                      , Quality:=xlQualityStandard, _
                                            IncludeDocProperties:=True, _
                                            IgnorePrintAreas:=False, _
                                            OpenAfterPublish:=False
            impression = MsgBox("Le fichier PDF nommé " & sNomFichierPDF & " à bien été crée dans le répertoire " & sNomDossier & Chr(10) & "Voulez-vous imprimer le PDF ?", vbYesNo)
                If impression = vbYes Then
                    PDFFilename = sNomDossier & sNomFichierPDF & ".pdf"
                    
    'Indiquer le chemin exacte pour Adobe Reader
                    acrobat = Shell("C:\Program Files (x86)\Adobe\Reader 11.0\Reader\AcroRd32.exe", vbNormalFocus)
                    
                    ShellExecute x, "print", PDFFilename, "", "", 1
                    Hdl& = FindWindow(vbNullString, "acrobat")
                    Rep& = PostMessage(Hdl&, WM_CLOSE, vbNull, vbNull)
                    Application.OnTime Now + TimeValue("00:00:05"), "ferme"
                 Else
                    Exit Sub
                End If
        Else
            Feuil2.Range("b17").Select
            MsgBox "Nom de fichier invalide", vbOKOnly + vbInformation, "Nom de Fichier"
        End If
    End If
End Sub
'suite code copie PDF1
Private Function NomFichierValide(sChaine As String) As Boolean
Dim i As Long
Const CaracInterdits As String = """*/:<>?[\]|"
    NomFichierValide = True
    For i = 1 To Len(CaracInterdits)
        If InStr(sChaine, Mid$(CaracInterdits, i, 1)) > 0 Then
            NomFichierValide = False
            Exit Function
        End If
    Next i
End Function
Sub ferme()
SendKeys "^{q}", True
End Sub

A+ Stéfan