XL 2016 enregistrer une zone d'impression en pdf

L

Linda42

XLDnaute Occasionnel
Bonjour,

J'ai besoin de votre aide pour pouvoir enregistrer une parti de ma feuille en PDF ou excel (le choix sera fait par l'utilisateur final).

Je suis partie avec l'idée de définir la zone d'impression souhaitée et l'enregistrer en pdf ou excel.

J'aimerais rajouter un message lorsqu'on cliquera sur le bouton "Vous préconisez l’adhésion à un groupement de commande ou à une centrale d’achats et avez fini de saisir votre fiche stratégie. Souhaitez vous enregistrer votre fichier sous pdf ou excel?

Et en fonction du choix, je souhaiterais que le chemin et le nom du fichier soit pré-défini :
Zone d'impression ou d'enregistrement A1:U104
Dans le fichier C\Users\mes documents (attention ce fichier est destiné à être utilisé par plusieurs utilisateurs - c'est donc dans leur document respectif que je voudrais que cela s'enregistre) une fois arrivé à cette étape, ils seront libres de choisir des dossiers/sous dossiers)
Avec un nom de fichier "Fiche Stratégie - " & .range("I110") & .range("I11") et je présume & ".pdf" ou excel

Meri pour votre aide.
Linda
 
Solution
kiki29
Re, la seule ligne suffit
VB: 
 Feuil1.PageSetup.PrintArea = "$A$1:$U$101"
Feuil1 étant le CodeName de l'onglet concerné.

Une version avec Test des noms de fichiers ainsi que gestion des doublons éventuels via un indice.
VB: 
Option Explicit

Sub EnregistrerSous_05()
Dim sNomFichier As String, sDossier As String
Dim oNomFichier As Variant,  sNomFinal As String
Dim bDoublon As Boolean

    bDoublon = True
    ' bDoublon = False
    sDossier = Environ("USERPROFILE") & "\" & "Documents"
    'sDossier = ThisWorkbook.Path

    sNomFichier = "Fiche Stratégie - " & Feuil1.Cells(10, 9) & " " & Feuil1.Cells(11, 9) & ".pdf"
    If NomFichierValide(sNomFichier) = False Then
        MsgBox "Attention : Nom de fichier invalide", vbOKOnly...
Trier par date Trier par votes
kiki29

kiki29

XLDnaute Barbatruc
Re, sauve la feuille Excel en PDF à toi de poursuivre.
VB: 
Sub EnregistrerSous_03()
Dim sNomFichier As String, sDossier As String
Dim oNomFichier As Variant

    sDossier = Environ("USERPROFILE") & "\" & "Documents"
    'sDossier = ThisWorkbook.Path

    sNomFichier = "Fiche Stratégie - " & Feuil1.Cells(10, 9) & " " & Feuil1.Cells(11, 9)

    oNomFichier = Application.GetSaveAsFilename(InitialFileName:=sDossier & "\" & sNomFichier, _
                                                fileFilter:="Fichiers PDF (*.pdf),*.pdf")
    If oNomFichier <> False Then
        Feuil1.ExportAsFixedFormat Type:=xlTypePDF, _
                                   Filename:=oNomFichier, _
                                   Quality:=xlQualityStandard, _
                                   IncludeDocProperties:=True, _
                                   IgnorePrintAreas:=False, _
                                   OpenAfterPublish:=False
    End If
End Sub
 
Dernière édition:
Vote positif 0 Vote négatif
L

Linda42

XLDnaute Occasionnel
kiki29 à dit:
Re, sauve la feuille Excel en PDF à toi de poursuivre.
VB: 
Sub EnregistrerSous_03()
Dim sNomFichier As String, sDossier As String
Dim oNomFichier As Variant

    sDossier = Environ("USERPROFILE") & "\" & "Documents"
    'sDossier = ThisWorkbook.Path

    sNomFichier = "Fiche Stratégie - " & Feuil1.Cells(10, 9) & " " & Feuil1.Cells(11, 9)

    oNomFichier = Application.GetSaveAsFilename(InitialFileName:=sDossier & "\" & sNomFichier, _
                                                fileFilter:="Fichiers PDF (*.pdf),*.pdf")
    If oNomFichier <> False Then
        Feuil1.ExportAsFixedFormat Type:=xlTypePDF, _
                                   Filename:=oNomFichier, _
                                   Quality:=xlQualityStandard, _
                                   IncludeDocProperties:=True, _
                                   IgnorePrintAreas:=False, _
                                   OpenAfterPublish:=False
    End If
End Sub
Cliquez pour agrandir...
Merci beaucoup pour cette aide précieuse, j'ai rajouté la zone d'impression avant, défini la nouvelle zone d'impression après. Ça fonctionne :)

VB: 
Sub ExpotPDF_Si_CA_GDC()
Dim sNomFichier As String, sDossier As String
Dim oNomFichier As Variant

    sDossier = Environ("USERPROFILE") & "\" & "Documents"
    'sDossier = ThisWorkbook.Path

    sNomFichier = "Fiche Stratégie - " & Feuil1.Cells(10, 9) & " " & Feuil1.Cells(11, 9)

    oNomFichier = Application.GetSaveAsFilename(InitialFileName:=sDossier & "\" & sNomFichier, _
                                                fileFilter:="Fichiers PDF (*.pdf),*.pdf")
    Range("A1:U101").Select
    Range("U101").Activate
    ActiveSheet.PageSetup.PrintArea = "$A$1:$U$101"
    
    If oNomFichier <> False Then
        Feuil1.ExportAsFixedFormat Type:=xlTypePDF, _
                                   Filename:=oNomFichier, _
                                   Quality:=xlQualityStandard, _
                                   IncludeDocProperties:=True, _
                                   IgnorePrintAreas:=False, _
                                   OpenAfterPublish:=False
    End If
    Range("A1:U334").Select
    ActiveSheet.PageSetup.PrintArea = "$A$1:$U$334"
End Sub
 
Vote positif 0 Vote négatif
kiki29

kiki29

XLDnaute Barbatruc
Re, la seule ligne suffit
VB: 
 Feuil1.PageSetup.PrintArea = "$A$1:$U$101"
Feuil1 étant le CodeName de l'onglet concerné.

Une version avec Test des noms de fichiers ainsi que gestion des doublons éventuels via un indice.
VB: 
Option Explicit

Sub EnregistrerSous_05()
Dim sNomFichier As String, sDossier As String
Dim oNomFichier As Variant,  sNomFinal As String
Dim bDoublon As Boolean

    bDoublon = True
    ' bDoublon = False
    sDossier = Environ("USERPROFILE") & "\" & "Documents"
    'sDossier = ThisWorkbook.Path

    sNomFichier = "Fiche Stratégie - " & Feuil1.Cells(10, 9) & " " & Feuil1.Cells(11, 9) & ".pdf"
    If NomFichierValide(sNomFichier) = False Then
        MsgBox "Attention : Nom de fichier invalide", vbOKOnly + vbCritical
        Exit Sub
    End If

    Feuil1.PageSetup.PrintArea = "$A$1:$U$101"

    oNomFichier = Application.GetSaveAsFilename(InitialFileName:=sDossier & "\" & sNomFichier, _
                                                fileFilter:="Fichiers PDF (*.pdf),*.pdf")
    If oNomFichier <> False Then
        sNomFinal = oNomFichier
        If bDoublon Then sNomFinal = RenommerFichier(sDossier, sNomFichier)
        Feuil1.ExportAsFixedFormat Type:=xlTypePDF, _
                                   Filename:=sNomFinal, _
                                   Quality:=xlQualityStandard, _
                                   IncludeDocProperties:=True, _
                                   IgnorePrintAreas:=False, _
                                   OpenAfterPublish:=False
    End If
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

Private Function RenommerFichier(sDossier As String, sNomFichier As String) As String
Dim sNouveauNom As String
Dim sPre As String, sExt As String
Dim i As Long
Dim Fso As Object

    Set Fso = CreateObject("Scripting.FileSystemObject")
    If Dir(sDossier & "\" & sNomFichier, vbNormal) <> vbNullString Then
        sNouveauNom = sNomFichier
        sPre = Fso.GetBaseName(sNomFichier)
        sExt = Fso.GetExtensionName(sNomFichier)

        i = 0
        While Dir(sDossier & "\" & sNouveauNom, vbNormal) <> vbNullString
            i = i + 1
            sNouveauNom = sPre & Chr(40) & Format(i, "000") & Chr(41) & Chr(46) & sExt
        Wend
        sNomFichier = sNouveauNom
    End If
    Set Fso = Nothing

    RenommerFichier = sDossier & "\" & sNomFichier
End Function
 

Pièces jointes

  • CodeName.png
    CodeName.png
    74.9 KB · Affichages: 27
  • 3.png
    3.png
    20.3 KB · Affichages: 29
Dernière édition:
Vote positif 0 Vote négatif
Solution
L

Linda42

XLDnaute Occasionnel
kiki29 à dit:
Re, la seule ligne suffit
VB: 
 Feuil1.PageSetup.PrintArea = "$A$1:$U$101"
Feuil1 étant le CodeName de l'onglet concerné.

Une version avec Test des noms de fichiers ainsi que gestion des doublons éventuels via un indice.
VB: 
Option Explicit

Sub EnregistrerSous_05()
Dim sNomFichier As String, sDossier As String
Dim oNomFichier As Variant,  sNomFinal As String
Dim bDoublon As Boolean

    bDoublon = True
    ' bDoublon = False
    sDossier = Environ("USERPROFILE") & "\" & "Documents"
    'sDossier = ThisWorkbook.Path

    sNomFichier = "Fiche Stratégie - " & Feuil1.Cells(10, 9) & " " & Feuil1.Cells(11, 9) & ".pdf"
    If NomFichierValide(sNomFichier) = False Then
        MsgBox "Attention : Nom de fichier invalide", vbOKOnly + vbCritical
        Exit Sub
    End If

    Feuil1.PageSetup.PrintArea = "$A$1:$U$101"

    oNomFichier = Application.GetSaveAsFilename(InitialFileName:=sDossier & "\" & sNomFichier, _
                                                fileFilter:="Fichiers PDF (*.pdf),*.pdf")
    If oNomFichier <> False Then
        sNomFinal = oNomFichier
        If bDoublon Then sNomFinal = RenommerFichier(sDossier, sNomFichier)
        Feuil1.ExportAsFixedFormat Type:=xlTypePDF, _
                                   Filename:=sNomFinal, _
                                   Quality:=xlQualityStandard, _
                                   IncludeDocProperties:=True, _
                                   IgnorePrintAreas:=False, _
                                   OpenAfterPublish:=False
    End If
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

Private Function RenommerFichier(sDossier As String, sNomFichier As String) As String
Dim sNouveauNom As String
Dim sPre As String, sExt As String
Dim i As Long
Dim Fso As Object

    Set Fso = CreateObject("Scripting.FileSystemObject")
    If Dir(sDossier & "\" & sNomFichier, vbNormal) <> vbNullString Then
        sNouveauNom = sNomFichier
        sPre = Fso.GetBaseName(sNomFichier)
        sExt = Fso.GetExtensionName(sNomFichier)

        i = 0
        While Dir(sDossier & "\" & sNouveauNom, vbNormal) <> vbNullString
            i = i + 1
            sNouveauNom = sPre & Chr(40) & Format(i, "000") & Chr(41) & Chr(46) & sExt
        Wend
        sNomFichier = sNouveauNom
    End If
    Set Fso = Nothing

    RenommerFichier = sDossier & "\" & sNomFichier
End Function
Cliquez pour agrandir...
Super,
j'ai utilisé ce code et cela fonctionne bien.


J'ai donc voulu le réutiliser sur une autre feuille du même fichier avec le code suivant :

VB: 
Option Explicit

Sub EnregistrerSous_Annexe1_PDF()
Dim sNomFichier As String, sDossier As String
Dim oNomFichier As Variant, sNomFinal As String
Dim bDoublon As Boolean

    bDoublon = True
    ' bDoublon = False
    sDossier = Environ("USERPROFILE") & "\" & "Documents"
    'sDossier = ThisWorkbook.Path

    sNomFichier = "Fiche Stratégie - " & Feuil1.Cells(10, 9) & " " & Feuil1.Cells(11, 9) & "  - Annexe 1" & ".pdf"
    If NomFichierValide(sNomFichier) = False Then
        MsgBox "Attention : Nom de fichier invalide", vbOKOnly + vbCritical
        Exit Sub
    End If


    oNomFichier = Application.GetSaveAsFilename(InitialFileName:=sDossier & "\" & sNomFichier, _
                                                fileFilter:="Fichiers PDF (*.pdf),*.pdf")
    If oNomFichier <> False Then
        sNomFinal = oNomFichier
        If bDoublon Then sNomFinal = RenommerFichier(sDossier, sNomFichier)
        Feuil1.ExportAsFixedFormat Type:=xlTypePDF, _
                                   Filename:=sNomFinal, _
                                   Quality:=xlQualityStandard, _
                                   IncludeDocProperties:=True, _
                                   IgnorePrintAreas:=False, _
                                   OpenAfterPublish:=False
    End If
    Range("A1").Select
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

Private Function RenommerFichier(sDossier As String, sNomFichier As String) As String
Dim sNouveauNom As String
Dim sPre As String, sExt As String
Dim i As Long
Dim Fso As Object

    Set Fso = CreateObject("Scripting.FileSystemObject")
    If Dir(sDossier & "\" & sNomFichier, vbNormal) <> vbNullString Then
        sNouveauNom = sNomFichier
        sPre = Fso.GetBaseName(sNomFichier)
        sExt = Fso.GetExtensionName(sNomFichier)

        i = 0
        While Dir(sDossier & "\" & sNouveauNom, vbNormal) <> vbNullString
            i = i + 1
            sNouveauNom = sPre & Chr(40) & Format(i, "000") & Chr(41) & Chr(46) & sExt
        Wend
        sNomFichier = sNouveauNom
    End If
    Set Fso = Nothing

    RenommerFichier = sDossier & "\" & sNomFichier
End Function


Il fonctionne mais l'export qui est fait est celui de la fiche stratégie et pas de la feuille souhaitée. J'ai tenté de trouver dans ton code la notion de active.sheet mais je coince.

Cdt
 
Vote positif 0 Vote négatif

Discussions similaires

F
  • Résolu(e)
XL 2019 Enregistrer sous la feuille active dans répertoire du fichier père en vba
2
Réponses
23
Affichages
1 K
Fabrice16ct
F
M
  • Question
Microsoft 365 Macro enregistrement PDF avec nom dans une cellule
Réponses
2
Affichages
1 K
kiki29
kiki29
C
  • Question
XL 2019 VBA Macro enregistrer en PDF
Réponses
4
Affichages
2 K
Lolote83
L
D
  • Question
Microsoft 365 Enregistré une feuille excel en pdf
Réponses
4
Affichages
1 K
kiki29
kiki29
P
  • Question
XL 2019 Enregistrer et imprimer une feuille en pdf
Réponses
9
Affichages
2 K
PeewhY
P
Q
  • Question
XL 2013 Définir ma zone d'impression avec un nombre de ligne qui n'est pas fixe
Réponses
6
Affichages
1 K
kiki29
kiki29
M
  • Question
XL 2016 Décocher l'option 'Compatible ISO 19005-1 (PDF/A)' lors d'un export en PDF
Réponses
0
Affichages
1 K
MinnieChat
M
Guy6363
  • Résolu(e)
XL 2010 Enregistrer un onglet au format PDF par macro
Réponses
5
Affichages
2 K
Guy6363
Guy6363
M
  • Question
XL pour MAC Macro simple Enregistrer sous PDF dans Bureau avec même nom
2
Réponses
29
Affichages
6 K
kiki29
kiki29
K
  • Résolu(e)
Microsoft 365 enregistrer une feuille excel en pdf
Réponses
7
Affichages
1 K
kamyolande
K

Membres actuellement en ligne

3 membres et 57 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
314 771
Messages
2 112 768
Membres
111 653
dernier inscrit
Vanie0082