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

L
  • Question
XL 2016 Fusionner PDF
Réponses
1
Affichages
169
kiki29
kiki29
M
  • Question
XL 2019 Macro empêcher enregistrer sous format pdf
Réponses
10
Affichages
247
Mulciber
M
C
  • Question
Microsoft 365 Génération PDF en fonction de critère
Réponses
4
Affichages
187
oguruma
oguruma
P
  • Résolu(e)
XL 2010 Enregistrer sous un seul PDF toutes les feuilles visibles d'un classeur
Réponses
3
Affichages
221
Panda79360
P
F
  • Question
Microsoft 365 macro edition détail d'un TCD et envoi dans un email
Réponses
1
Affichages
95
fabancel
F
S
  • Question
XL 2016 Macro pour convertir .PDF en .XLSX
2 3 4
Réponses
58
Affichages
1 K
kiki29
kiki29
M
  • Question
XL 2010 sauvegarder des images en fichier pdf par vba
Réponses
7
Affichages
288
patricktoulon
patricktoulon
J
  • Question
Base de données avec userform d'enregistrement et état imprimable en pdf
Réponses
2
Affichages
283
juniorekondo.36
J
Y
  • Question
Microsoft 365 Creer pdf selon condition
Réponses
1
Affichages
173
job75
job75
L
  • Résolu(e)
XL 2019 Important : Nommer fichier grâce aux éléments de publipostage
Réponses
6
Affichages
247
LeForain
L

Membres actuellement en ligne

12 membres et 211 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
312 177
Messages
2 085 973
Membres
103 073
dernier inscrit
MSCHOE16