Autres Sauvegarde d'une séléction en pdf (Excel 2007)

Lauvia

XLDnaute Nouveau
Bonjour,

j'ai fait un Excel pour gérer un certain nombre de choses dont la sauvegarde de facture dans un dossier spécifique.
J'utilise PDFCreator pour l'écriture en pdf.
Mon fichier est bien sauvegargé à l'endroit exact mais malheureusement sans extension et du coup je ne peux pas ouvrir,
même pas en y accolant ".pdf" à la fin.
Quelqu'un a-t-il une idée du pourquoi de comment?

Merci pour toute réponse rapide.

Cordialement.
 

Pièces jointes

  • Test.xlsm
    64.6 KB · Affichages: 0
Dernière édition:
Solution
re, comme cela tu crées un fichier PostScript( *.ps ), il faut ensuite le convertir en PDF.
Il te faut pour cela Acrobat ( pas le Reader ) voir un exemple ici
Bref tu t'embarques dans le genre : pourquoi faire simple quand on peut faire compliqué.
Normalement ceci devrait suffire :
VB:
Private Declare Function SHCreateDirectoryEx Lib "Shell32.dll" Alias "SHCreateDirectoryExA" _
                                             (ByVal hwnd As Long, _
                                              ByVal pszPath As String, _...

kiki29

XLDnaute Barbatruc
Salut, depuis Office 2007 SP2 la sauvegarde en PDF est intégré à Office
sinon adapter à ton contexte ceci :

Code:
Option Explicit

Private Function GetPrinterWithPort(ByVal sPrinterName As String) As String
Dim Reg As Variant, oReg As Object, myStr 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", myStr, 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 Test_PDFCreator_02()
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, ActivePrinter:= _
                                         GetPrinterWithPort("PDFCreator"), Collate:=True
End Sub
 

Lauvia

XLDnaute Nouveau
Salut, depuis Office 2007 SP2 la sauvegarde en PDF est intégré à Office
sinon adapter à ton contexte ceci :

Code:
Option Explicit

Private Function GetPrinterWithPort(ByVal sPrinterName As String) As String
Dim Reg As Variant, oReg As Object, myStr 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", myStr, 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 Test_PDFCreator_02()
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, ActivePrinter:= _
                                         GetPrinterWithPort("PDFCreator"), Collate:=True
End Sub
Bonsoir Kiki,

et merci pour ton retour.
Ton script est un peu plus...professionnel :) . J'ai déjà pu obtenir ce résultat.
Mon soucis est plutôt dans l'utilisation automatique d'un nom généré par l'autre partie de mon tool, et surtout le chemin de sauvegarde spécifié.

Code:
Sub Test_PDFCreator_02(path As Variant)
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, ActivePrinter:= _
    GetPrinterWithPort("PDFCreator"), PrintToFile:=True, Collate:=True, PrToFileName:=path
End Sub

avec path = chemin/nomFichier

C'est là où tout se gâte. il crée bien le fichier mais sans aucune extension (.pdf)
 

kiki29

XLDnaute Barbatruc
re, comme cela tu crées un fichier PostScript( *.ps ), il faut ensuite le convertir en PDF.
Il te faut pour cela Acrobat ( pas le Reader ) voir un exemple ici
Bref tu t'embarques dans le genre : pourquoi faire simple quand on peut faire compliqué.
Normalement ceci devrait suffire :
VB:
Private Declare Function SHCreateDirectoryEx Lib "Shell32.dll" Alias "SHCreateDirectoryExA" _
                                             (ByVal hwnd As Long, _
                                              ByVal pszPath As String, _
                                              ByVal lngsec As Long) As Long

Option Explicit

Private Function CreationDossier(sDossier As String) As Long
Dim Rep As Long
    Rep = SHCreateDirectoryEx(0&, sDossier, 0&)
End Function

Sub Impression()
Dim sFichier As String
Dim sDossier As String

    sDossier = ThisWorkbook.Path & "\" & "Tests"
    CreationDossier sDossier

    sFichier = "Test.pdf"

    Feuil6.ExportAsFixedFormat Type:=xlTypePDF, _
                               Filename:=sDossier & "\" & sFichier, _
                               Quality:=xlQualityStandard, _
                               IncludeDocProperties:=True, _
                               IgnorePrintAreas:=False, _
                               From:=1, To:=1, _
                               OpenAfterPublish:=False
End Sub

Feuil6 est le CodeName de l'onglet "Facture", ceci permet de ne pas retoucher au code VBA si l'on renomme ou déplace l'onglet Facture.
 

Pièces jointes

  • 1.png
    1.png
    66.3 KB · Affichages: 3
Dernière édition:

patricktoulon

XLDnaute Barbatruc
bonjour
si tu veux imprimer en pdf une plage c'est la selection qu'il faut exporter pas la feuille
pour le reste de ton code il est un peu a rallonge mais ca fonctionne
VB:
Sub Impression()
    Dim sFichier As String
    Dim sDossier As String
    Dim Fact As Variant, nomFichier As String

    Set Fact = Worksheets("Facture")
    nomFichier = Fact.Cells(14, 5).Value    'lire le nom du fichier depuis la feuille facture, cellule E14
    sDossier = ThisWorkbook.path & "\" & "Factures"   'chemin d'accès au dossier Factures

    sFichier = nomFichier & ".pdf"

    Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
                                  sDossier & "\" & sFichier, Quality:=xlQualityStandard, _
                                  IncludeDocProperties:=True, IgnorePrintAreas:=False, From:=1, To:=1, _
                                  OpenAfterPublish:=False

End Sub
 

patricktoulon

XLDnaute Barbatruc
avec un peu de netoyage de code ca donne ça
VB:
Private Function CreationDossier(sDossier As String) As Long
    If Dir(sDossier, vbDirectory) = "" Then MkDir sDossier: MsgBox "le dossier a été créé"
End Function


Private Sub imprimer_Click(): ImpFacture: End Sub


Sub ImpFacture()
    Dim lgdeb, lgfin, cldeb, clfin As Integer
    Dim Msg, Style, Title, Help, Ctxt, Response, MyString
    Dim sDossier As String

    sDossier = ThisWorkbook.path & "\" & "Factures"   'chemin d'accès au dossier Factures

    CreationDossier (sDossier)   ' test d'existence du dossier 'Factures' et création le cas échéant

    Msg = "Voulez vous Imprimer la Facture?"
    Title = "Impression Document "    ' Définit le titre.
    Style = vbYesNo + vbExclamation + vbDefaultButton2    '+ vb    ' Définit les boutons.
    Response = MsgBox(Msg, Style, Title)

    If Response = vbYes Then    ' L'utilisateur a choisi Oui.
        lgdeb = 3    ' début ligne d'impression
        cldeb = 2    'début colonne d'impression
        lgfin = 55    ' fin ligne d'impression
        clfin = 12    ' fin colonne d'impression
        Sheets("Facture").Select
        Range(Cells(lgdeb, cldeb), Cells(lgfin, clfin)).Select    '(Cells(lgdeb, cldeb), Cells(lgfin, clfin)).Select

        Impression
    End If

    If Response = vbNo Then  'L'utilisateur a choisi "non" et sauvegarde la facture en PDF

    End If
End Sub


Sub Impression()
    Dim sFichier As String
    Dim sDossier As String
    Dim Fact As Variant, nomFichier As String

    Set Fact = Worksheets("Facture")
    nomFichier = Fact.Cells(14, 5).Value    'lire le nom du fichier depuis la feuille facture, cellule E14
    sDossier = ThisWorkbook.path & "\" & "Factures"   'chemin d'accès au dossier Factures

    sFichier = nomFichier & ".pdf"

    Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
                                  sDossier & "\" & sFichier, Quality:=xlQualityStandard, _
                                  IncludeDocProperties:=True, IgnorePrintAreas:=False, From:=1, To:=1, _
                                  OpenAfterPublish:=False

End Sub
et on peu encore simplifier
 

patricktoulon

XLDnaute Barbatruc
re et avec un gros netoyage ça donne ça
la sub impression est maintenant argumentée
VB:
Private Sub imprimer_Click(): ImpFacture: End Sub

Private Function GetDossier(sdossier As String) As String
    If Dir(sdossier, vbDirectory) = "" Then MkDir sdossier: MsgBox "le dossier a été créé"
        GetDossier = sdossier
End Function

Sub ImpFacture()
    Dim sdossier As String, rng As Range, feuille As Worksheet, nomPDF As String

    If MsgBox("Voulez vous Imprimer la Facture?", vbYesNo + vbExclamation + vbDefaultButton2, "Impression Document ") = vbYes Then

        sdossier = GetDossier(ThisWorkbook.path & "\" & "Factures")   ' teste l'existence du dossier 'Factures' et le créé si il n'existe pas
        Set feuille = Sheets("Facture")    'détermine la feuille(object worksheet)
        Set rng = feuille.Range(feuille.Cells(3, 2), feuille.Cells(55, 12))    'détermine la plage a imprimer en pdf
        nomPDF = feuille.Cells(14, 5).Value & ".pdf"    'détermine le nom du fichier
        ImpressionPDF feuille, rng, nomPDF, sdossier    'lance l'impression avec les parametres

    Else: MsgBox "impression annulée"    'si vbno msgbox d'annulation
    End If
End Sub


Sub ImpressionPDF(feuille As Worksheet, rng As Range, nomPDF As String, sdossier As String)
    feuille.Activate: rng.Select
    Selection.ExportAsFixedFormat Type:=xlTypePDF, _
                                  Filename:=sdossier & "\" & nomPDF, _
                                  Quality:=xlQualityStandard, _
                                  IncludeDocProperties:=True, _
                                  IgnorePrintAreas:=False, _
                                  From:=1, To:=1, _
                                  OpenAfterPublish:=False

    [A1].Select
End Sub
demain tu veux modifier quelque chose tu n'aura qu'a modifier ces lignes
VB:
sdossier = GetDossier(ThisWorkbook.path & "\" & "Factures")   ' teste l'existence du dossier 'Factures' et le créé si il n'existe pas
Set feuille = Sheets("Facture")    'détermine la feuille(object worksheet)
Set rng = feuille.Range(feuille.Cells(3, 2), feuille.Cells(55, 12))    'détermine la plage a imprimer en pdf
nomPDF = feuille.Cells(14, 5).Value & ".pdf"    'détermine le nom du fichier
;)
 

Discussions similaires

Haut Bas