XL 2013 Macro pour enregistrer en PDF

SERRANO · 7 Juin 2022

Bonjour à toutes et à tous,

Voici un fichier que j'ai construis mais je bloque sur la macro.

Je souhaiterai que dans l'onglet formulaire grâce au petit bouton le fichier excel s'enregistre en PDF.

Dans un lieu bien précis comme indiqué, et que le nommage corresponde à la cellule K1.

Sauf que le nommage bloque sur ma macro.

Merci à vous pour votre aide.

Bernard_XLD · 7 Juin 2022

Bonjour SERRANO, le forum

Remplacez monFichier As StdFont par monFichier As String et cela devrait mieux fonctionner.

Cordialement, @+

Bernard_XLD · 7 Juin 2022

Bonjour SERRANO, le forum

Remplacez monFichier As StdFont par monFichier As String et cela devrait mieux fonctionner.

Cordialement, @+

SERRANO · 7 Juin 2022

Bernard_XLD à dit:
Bonjour SERRANO, le forum

Remplacez monFichier As StdFont par monFichier As String et cela devrait mieux fonctionner.

Cordialement, @+

Bonjour Bernard,

Effectivement c'est mieux !!!

kiki29 · 8 Juin 2022

Salut, si tu es curieuse voir Liste Contributions PDF

SERRANO · 10 Juin 2022

kiki29 à dit:
Salut, si tu es curieuse voir Liste Contributions PDF

Bonjour Kiki29, je vais regarder !!!

Par contre, je vais avoir encore besoin de vous car je sèche un peu !!!

Il faudrait avant de créer le PDF
1. Créer un dossier avec le nom de la céllule K2
dans M:\O_DIP\6_Execution_comptable\liquidation_lyon\Bons_commande\Demande\Fiches liaisons et devis\"
2. Et Créer ce fameux PDF dans le fameux Dossier Céer juste avant

A votre avis c'est possible ?

kiki29 · 10 Juin 2022

Salut, cela devrait suffire, le chemin est à adapter à ton contexte

VB:

Option Explicit

Sub Créer_PDF_02()
Dim monDossier As String, monFichier As String
Dim sChaine As String

    monDossier = "c:\Test\Fiches"
    monFichier = Feuil2.[k1]

    sChaine = Environ("comspec") & " /c mkdir " & monDossier
    Shell sChaine, 0

    If NomFichierValide(monFichier) = False Then
        Feuil2.[k1].Select
        MsgBox "Nom de Fichier Invalide", vbOKOnly + vbCritical
        Exit Sub
    End If

    With Feuil2
        .PageSetup.BlackAndWhite = False
        .ExportAsFixedFormat Type:=xlTypePDF, _
                             Filename:=monDossier & "\" & monFichier, _
                             Quality:=xlQualityStandard, _
                             IncludeDocProperties:=True, _
                             IgnorePrintAreas:=False, _
                             OpenAfterPublish:=False
    End With
End Sub

Private Function NomFichierValide(sChaine As String) As Boolean
Dim i As Long
Const sCaracInterdits As String = """*/:<>?\|[]"
    NomFichierValide = True
    If Len(sChaine) = 0 Then
        NomFichierValide = False
        Exit Function
    End If
    For i = 1 To Len(sCaracInterdits)
        If InStr(sChaine, Mid$(sCaracInterdits, i, 1)) > 0 Then
            NomFichierValide = False
            Exit Function
        End If
    Next i
End Function

SERRANO · 13 Juin 2022

kiki29 à dit:

Salut, cela devrait suffire, le chemin est à adapter à ton contexte

VB:

Option Explicit

Sub Créer_PDF_02()
Dim monDossier As String, monFichier As String
Dim sChaine As String

    monDossier = "c:\Test\Fiches"
    monFichier = Feuil2.[k1]

    sChaine = Environ("comspec") & " /c mkdir " & monDossier
    Shell sChaine, 0

    If NomFichierValide(monFichier) = False Then
        Feuil2.[k1].Select
        MsgBox "Nom de Fichier Invalide", vbOKOnly + vbCritical
        Exit Sub
    End If

    With Feuil2
        .PageSetup.BlackAndWhite = False
        .ExportAsFixedFormat Type:=xlTypePDF, _
                             Filename:=monDossier & "\" & monFichier, _
                             Quality:=xlQualityStandard, _
                             IncludeDocProperties:=True, _
                             IgnorePrintAreas:=False, _
                             OpenAfterPublish:=False
    End With
End Sub

Private Function NomFichierValide(sChaine As String) As Boolean
Dim i As Long
Const sCaracInterdits As String = """*/:<>?\|"
    NomFichierValide = True
    If Len(sChaine) = 0 Then
        NomFichierValide = False
        Exit Function
    End If
    For i = 1 To Len(sCaracInterdits)
        If InStr(sChaine, Mid$(sCaracInterdits, i, 1)) > 0 Then
            NomFichierValide = False
            Exit Function
        End If
    Next i
End Function

Bonjour,

Je suis en train de regarder et j'ai une question ? Est ce qu'il crée un dossier aussi ? Par ce que j'ai que le PDF

kiki29 · 13 Juin 2022

re, remplace "c:\Test\Fiches"
par "M:\O_DIP\6_Execution_comptable\liquidation_lyon\Bons_commande\Demande\Fiches_liaisons_et_devis"

SERRANO · 13 Juin 2022

kiki29 à dit:
re, remplace "c:\Test\Fiches"
par "M:\O_DIP\6_Execution_comptable\liquidation_lyon\Bons_commande\Demande\Fiches_liaisons_et_devis"

Merci beaucoup kiki29;

Ça marche bien sauf que le nom du dossier ne se nomme pas FL 1 mais Fiches_liaisons_et_devis et surtout je voudrais qu'il rentre dans ce dossier

kiki29 · 13 Juin 2022

re, avec un délai à ajuster, ici Delai 250 pour 250 ms

VB:

Option Explicit

Sub Créer_PDF_03()
Dim monDossier As String, monFichier As String
Dim sCommande As String, FSO As Object

    monDossier = "C:\Test\Fiches"
    monFichier = Feuil2.[k1]

    sCommande = Environ("comspec") & " /c mkdir " & monDossier
    Shell sCommande, 0

    Delai 250

    If NomFichierValide(monFichier) = False Then
        Feuil2.[k1].Select
        MsgBox "Nom de Fichier Invalide", vbOKOnly + vbCritical
        Exit Sub
    End If
 
    With Feuil2
        .PageSetup.BlackAndWhite = False
        .ExportAsFixedFormat Type:=xlTypePDF, _
                             Filename:=monDossier & "\" & monFichier, _
                             Quality:=xlQualityStandard, _
                             IncludeDocProperties:=True, _
                             IgnorePrintAreas:=False, _
                             OpenAfterPublish:=False
    End With
End Sub

Private Function Delai(ByVal ms As Long)
    Delai = Timer + ms / 1000
    While Timer < Delai: DoEvents: Wend
End Function

Private Function NomFichierValide(sChaine As String) As Boolean
Dim i As Long
Const sCaracInterdits As String = """*/:<>?\|"
    NomFichierValide = True
    If Len(sChaine) = 0 Then
        NomFichierValide = False
        Exit Function
    End If
    For i = 1 To Len(sCaracInterdits)
        If InStr(sChaine, Mid$(sCaracInterdits, i, 1)) > 0 Then
            NomFichierValide = False
            Exit Function
        End If
    Next i
End Function

SERRANO · 13 Juin 2022

kiki29 à dit:

re, avec un délai à ajuster, ici Delai 250 pour 250 ms

VB:

Option Explicit

Sub Créer_PDF_03()
Dim monDossier As String, monFichier As String
Dim sCommande As String, FSO As Object

    monDossier = "C:\Test\Fiches"
    monFichier = Feuil2.[k1]

    sCommande = Environ("comspec") & " /c mkdir " & monDossier
    Shell sCommande, 0

    Delai 250

    If NomFichierValide(monFichier) = False Then
        Feuil2.[k1].Select
        MsgBox "Nom de Fichier Invalide", vbOKOnly + vbCritical
        Exit Sub
    End If
 
    With Feuil2
        .PageSetup.BlackAndWhite = False
        .ExportAsFixedFormat Type:=xlTypePDF, _
                             Filename:=monDossier & "\" & monFichier, _
                             Quality:=xlQualityStandard, _
                             IncludeDocProperties:=True, _
                             IgnorePrintAreas:=False, _
                             OpenAfterPublish:=False
    End With
End Sub

Private Function Delai(ByVal ms As Long)
    Delai = Timer + ms / 1000
    While Timer < Delai: DoEvents: Wend
End Function

Private Function NomFichierValide(sChaine As String) As Boolean
Dim i As Long
Const sCaracInterdits As String = """*/:<>?\|"
    NomFichierValide = True
    If Len(sChaine) = 0 Then
        NomFichierValide = False
        Exit Function
    End If
    For i = 1 To Len(sCaracInterdits)
        If InStr(sChaine, Mid$(sCaracInterdits, i, 1)) > 0 Then
            NomFichierValide = False
            Exit Function
        End If
    Next i
End Function

SERRANO · 13 Juin 2022

:-(
Je me suis mal exprimer !!! Je vais refaire ma demande

SERRANO · 13 Juin 2022

Mon fichier etant trop lourd j'ai réduit sa taille

Dans formulaire
1. il faudra qu'il rentre son numéro dans D3 (la K1 se mettra en automatique, c'est pour le nommage du dossier et du PDF
2. En cliquant sur enregistrer PDF, je souhaiterai que

a. Un dossier se crée avec le nommage de K1 dans M:\O_DIP\6_Execution_comptable\liquidation_lyon\Bons_commande\Demande\Fiches liaisons et devis Exemple FL 1
b. Dans ce dossier nommé comme K1, le formulaire s'enregistre en PDF et nommage de K1

Deadpool_CC · 13 Juin 2022

Bonjour, je vois que c'est pas le code de kiki29 ... lol

Bon à partir de ton code essaye cela :

VB:

Sub Créer_PDF()
'
' Créer_PDF Macro
'

'
    Dim monDossier As String, monFichier As String
    monDossier = "M:\O_DIP\6_Execution_comptable\liquidation_lyon\Bons_commande\Demande\Fiches liaisons et devis"
    monFichier = [k1]
    ChDir monDossier
    MkDir monFichier
    
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        monDossier & "\" & monFichier & "\" & monFichier & ".pdf", _
        Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
        :=False, OpenAfterPublish:=False
End Sub

attention, : j'ai pas vérifié si le dossier existait déjà et si le fichier existait déjà

Deadpool_CC · 13 Juin 2022

Kiki29 te propose des solutions plus abouties ... tu devrais mieux lire les siennes

XL 2013 Macro pour enregistrer en PDF

SERRANO

XLDnaute Nouveau

Pièces jointes

Bernard_XLD

Bernard_XLD

XLDnaute Barbatruc

SERRANO

XLDnaute Nouveau

kiki29

XLDnaute Barbatruc

SERRANO

XLDnaute Nouveau

kiki29

XLDnaute Barbatruc

SERRANO

XLDnaute Nouveau

kiki29

XLDnaute Barbatruc

Pièces jointes

SERRANO

XLDnaute Nouveau

kiki29

XLDnaute Barbatruc

SERRANO

XLDnaute Nouveau

SERRANO

XLDnaute Nouveau

SERRANO

XLDnaute Nouveau

Pièces jointes

Deadpool_CC

XLDnaute Accro

Deadpool_CC

XLDnaute Accro

Discussions similaires