VBA sauvegarde en format PDF

Ofeu Messages postés 26 Statut Membre -  
cs_Le Pivert Messages postés 8437 Statut Contributeur -
Bonjour à tous,

Je voudrais un codage VBA pour le sauvergarde de mon fichier Excel en format PDF.
Pour cela, j'ai procédé avec le codage suivant. Cependant j'ai un erreur. 

Sub Ellipse2_Cliquer()
nomdossier = Application.InputBox(prompt:="Dossier d'enregistrement:", Type:=2)
dossier = "C:\Users\Desktop\" & nomdossier & "\"

ActivateSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
dossier & "_MFA" & ".pdf", quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=True


End Sub


Merci
Bien cdlt
Lucas

EDIT : Ajout des balises de code (la coloration syntaxique).
Explications disponibles ici : ICI

Merci d'y penser dans tes prochains messages.

1 réponse

  1.
    cs_Le Pivert Messages postés 8437 Statut Contributeur 730
     
    Bonjour,

    pour faire ce que tu veux, il faut créer un dossier, ensuite le chemin du bureau est faux, il faut le chercher

    Voilà comment procéder: 

    Option Explicit
Dim nomdossier As String
Dim dossier As String
Dim bureau As String
Private Sub CommandButton1_Click()
nomdossier = Application.InputBox(prompt:="Dossier d'enregistrement:", Type:=2)
cheminbureau
TesteSiDossierExiste
dossier = bureau & "\" & nomdossier & "\"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        dossier & "_MFA.pdf", Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
        True
End Sub
Sub TesteSiDossierExiste()
'https://excel-malin.com/codes-sources-vba/vba-verifier-si-dossier-existe/
Dim MonDossier As String

MonDossier = bureau & "\" & nomdossier

    If DossierExiste(MonDossier) = True Then
       ' MsgBox "Le dossier existe..."
    Else
      MkDir (bureau & "\" & nomdossier)
    End If

End Sub
Public Function DossierExiste(MonDossier As String)
'par Excel-Malin.com ( http://excel-malin.com )

   If Len(Dir(MonDossier, vbDirectory)) > 0 Then
      DossierExiste = True
   Else
      DossierExiste = False
   End If
End Function
Private Sub cheminbureau()
'https://excel-malin.com/codes-sources-vba/trouver-chemin-de-bureau/

    On Error GoTo TestErreur
    Dim cheminbureau As String
    
    cheminbureau = ObtenirCheminBureau()
    
    bureau = cheminbureau 'affiche le chemin vers le dossier Bureau
    Exit Sub
TestErreur:
    MsgBox "Une erreur s'est produite..."
End Sub
Public Function ObtenirCheminBureau() As String
'par: Excel-Malin.com ( https://excel-malin.com )

    On Error GoTo ObtenirCheminBureauError
    Dim cheminbureau As String
    cheminbureau = ""
    Dim oWSHShell As Object
    Set oWSHShell = CreateObject("WScript.Shell")
    
    cheminbureau = oWSHShell.SpecialFolders("Desktop")
    
    If (Not (oWSHShell Is Nothing)) Then Set oWSHShell = Nothing
    ObtenirCheminBureau = cheminbureau

    Exit Function
ObtenirCheminBureauError:
    If (Not (oWSHShell Is Nothing)) Then Set oWSHShell = Nothing
    ObtenirCheminBureau = ""
End Function


    Voilà
    0
    1. Ofeu Messages postés 26 Statut Membre
       
      BOnsoir cs_LE Pivert !

      Merci de votre aide, vraiment !
      Oui, j'arrive garder sur format pdf, cependant lorsque j'appuie sur mon bouton pour sauver en format pdf (fenêtre pour permettre de mettre le nom de mon fichier), j'ai deux bouton en bas (ok et annuler), cependant même si j'appuie sur annuler, mon fichier fait la sauvegarde.

      Une autre qustion que j'avais essayé de faire mais je pense que cela n'est pas possible (problème = la cellule X a une formule qui concerne la concaténation de deux autres cellules). En faite je voulais que la sauvegarde récupere une valeur d'une cellule X. J'ai essayé de faire de la façon suivante 

      ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
              nomdossier & "_" & Sheets("Model_FA").Range("D6").Value & "_MFA.pdf", Quality:=xlQualityStandard,
              IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True


      j'ai également changé "value" pour "text" et "select"; "Range" pour "Cells". Mais j'ai toujours de problème auquel je pense qui vient du fait que cette cellule contient une formule qui est la concaténation de deux autres cellules.
      Alors que j'ai essayé une cellule sans formule et ça marche bien.

      Est-ce possible de l'intergrer cette cellule (contenant une formule) dans le nom de sauvegarde ?

      Grand merci !!!
      A bientôt,
      Lucas
      0
    2. cs_Le Pivert Messages postés 8437 Statut Contributeur 730
       
      Pour la 1ère question voir ceci:

      https://forums.commentcamarche.net/forum/affich-37636380-vba-inputbox#inputbox-les-boutons

      et pour la 2ème 

      ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
nomdossier & "_" & Sheets("Model_FA").Range("D6").Value & "_MFA.pdf", Quality:=xlQualityStandard,
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True



      il faut mettre dossier et non nomdossier , l'erreur vient de là 

      dossier = bureau & "\" & nomdossier & "\"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        dossier & "_" & Sheets("Model_FA").Range("D6").Value & "_MFA.pdf", Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
        True


      @+ Le Pivert
      0