XL 2013 Macro pour enregistrer en PDF

S

SERRANO

XLDnaute Nouveau
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.
 

Pièces jointes

  • Demande de BC V2.xlsm
    44.5 KB · Affichages: 22
Trier par date Trier par votes
S

SERRANO

XLDnaute Nouveau
kiki29 à dit:
Salut, si tu es curieuse voir Liste Contributions PDF
Cliquez pour agrandir...
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 ?
 
Vote positif 0 Vote négatif
kiki29

kiki29

XLDnaute Barbatruc
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
 
Dernière édition:
Vote positif 0 Vote négatif
S

SERRANO

XLDnaute Nouveau
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
Cliquez pour agrandir...
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
 
Vote positif 0 Vote négatif
kiki29

kiki29

XLDnaute Barbatruc
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
 
Vote positif 0 Vote négatif
S

SERRANO

XLDnaute Nouveau
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
Cliquez pour agrandir...
 
Vote positif 0 Vote négatif
S

SERRANO

XLDnaute Nouveau
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

1655127201380.png
 

Pièces jointes

  • FORMULAIRE SEUL.xlsm
    30.3 KB · Affichages: 10
Vote positif 0 Vote négatif
Deadpool_CC

Deadpool_CC

XLDnaute Accro
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à
 
Vote positif 0 Vote négatif

Discussions similaires

S
  • Question
XL 2019 enregistrement pdf avec variable et format variable
Réponses
10
Affichages
289
sofmat
S
A
  • Question
XL 2010 Enregistrer en PDF
Réponses
2
Affichages
176
Appo1985
A
M
  • Résolu(e)
XL 2013 VBA enregistrement fichier dans un dossier en particulier
Réponses
3
Affichages
312
MarineU
M
T
  • Question
XL 2016 Preparer mon publipostage avant export
Réponses
0
Affichages
76
tuti
T
N
  • Question
XL 2016 Code VBA pour envoi de mail avec pdf en piece jointe
Réponses
4
Affichages
307
Phil69970
Phil69970
G
  • Question
XL 2016 Extraire des données d'un pdf et les copier dans excel
2
Réponses
17
Affichages
813
gali2
G
F
  • Question
Microsoft 365 Problème avec VBA ( Résolu)
Réponses
2
Affichages
301
firecarl
F
M
  • Question
XL 2013 MACRO VBA pour imprimer tous les bulletins d'un établissement scolaire
Réponses
4
Affichages
218
MBEPID
M
R
  • Résolu(e)
Microsoft 365 Export PDF VBA suivant critères
Réponses
3
Affichages
303
raf26
R
L
  • Question
XL 2016 Fusionner PDF
Réponses
1
Affichages
448
kiki29
kiki29

Membres actuellement en ligne

13 membres et 95 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
315 090
Messages
2 116 107
Membres
112 661
dernier inscrit
ceucri