Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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

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:
Réactions: cp4
Vote positif 0 Vote négatif
L

Linda42

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

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
    74.9 KB · Affichages: 27
  • 3.png
    20.3 KB · Affichages: 29
Dernière édition:
Réactions: cp4
Vote positif 0 Vote négatif
Solution
L

Linda42

XLDnaute Occasionnel
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
Identifiez-vous ou inscrivez-vous pour participer.

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
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
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
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
  • Résolu(e)
XL 2010 Enregistrer un onglet au format PDF par macro
Réponses
5
Affichages
2 K
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
K
  • Résolu(e)
Microsoft 365 enregistrer une feuille excel en pdf
Réponses
7
Affichages
1 K
kamyolande
K
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…