XL 2016 Impression feuille Excel en PDF

[PICOU0510]

Bonjour à tous et à toutes,

Me voila une fois perdu, malgré quelques recherches sur des forums. C'est pourquoi je viens vers vous.

J'ai un fichier (EVALUATION DES DEPENSES) crée deux macros (masquer ligne vide et montrer ligne vide) qui me permettent de masquer certaines lignes lorsque la quantité est nulle. J'ai besoin de vous car je souhaite pouvoir imprimer cette feuille (lorsque les lignes sont masquées) en PDF et l'enregistrer selon un chemin d'accès bien précis. Je souhaiterai également que cette feuille s'imprime et s'enregistre mais sans les lignes 120-121-122...-128. Soit deux impressions et deux enregistrements sur le même bouton.

De plus si ce n'est pas trop demandé, j'aimerais que le nom du fichier s'enregistre selon la forme suivante : cellule(C4)_cellule(B2)_cellule(F4)_depenses.pdf

Je vous remercie par avance de toute l'attention que vous porterez à mon sujet.

Vous trouverez dans certaines cellules des formules qui ne doivent pas fonctionner c'est normal j'ai supprimé des données confidentielles

Merci

Ps: je vous joint le fichier joint sans les informations confidentielles)

 

[kiki29]

Salut, voir ici et là puis adapte à ton contexte

 

[PICOU0510]

Salut, voir ici et là et adapter à ton contexte

Je vois bien certains code mais le truc c est que je n y comprends rien à cette programmation... déclaration de variable,sélection des cellules sélectionnées des lignes intégration des macros déjà existantes ...etc,etc

 

[kiki29]

Salut, n'étant pas un partisan du "tout cuit", à toi de poursuivre en adaptant à ton contexte.

Option Explicit

Private Declare Function SHCreateDirectoryEx Lib "Shell32.dll" Alias "SHCreateDirectoryExA" _
                                             (ByVal hwnd As Long, _
                                              ByVal pszPath As String, _
                                              ByVal lngsec As Long) As Long

Const sDossier As String = "C:\...\...\...\...\Test Gestion"

Private Function CreationDossier(sDossier) As Long
Dim Rep As Long
    Rep = SHCreateDirectoryEx(0&, sDossier, 0&)
End Function

Sub Effacer()
    Application.ScreenUpdating = False
    Feuil1.Range("C4:D4,H6:H119").ClearContents
    Application.ScreenUpdating = True
End Sub

Sub Impression()
Dim sExt As String, pos As Long, sChemin As String
Dim sNomFichier As String, oNomFichier As Variant
Dim sFichierFinal As String, sPre As String

    CreationDossier sDossier
   
    sPre = Feuil1.Range("C4") & " " & Feuil1.Range("B2") & " " & Feuil1.Range("E4")
    sNomFichier = sPre & " Dépenses.pdf"

    sExt = ".pdf"

    If NomFichierValide(sNomFichier) = False Then
        MsgBox "Nom de fichier invalide !", vbCritical + vbOKOnly
        Exit Sub
    End If

    ChDir sDossier

    oNomFichier = Application.GetSaveAsFilename(InitialFileName:=sNomFichier, _
                                                fileFilter:="Fichiers PDF (*" & sExt & ", *" & sExt)
    If oNomFichier <> False Then
        pos = InStrRev(oNomFichier, "\")
        sChemin = Left$(oNomFichier, pos - 1)

        sFichierFinal = RenommerFichier(sChemin, sNomFichier)
        Masquer_lignes_Vides
        Masquer_lignes_120_128
        DoEvents
        Feuil1.ExportAsFixedFormat Type:=xlTypePDF, _
                                        Filename:=sFichierFinal, _
                                        Quality:=xlQualityStandard, _
                                        IncludeDocProperties:=True, _
                                        IgnorePrintAreas:=False, _
                                        OpenAfterPublish:=False
        Montrer_lignes_Vides
        Montrer_lignes_120_128
        DoEvents
        sNomFichier = sPre & " All" & " Dépenses.pdf"
        sFichierFinal = RenommerFichier(sChemin, sNomFichier)
        Feuil1.ExportAsFixedFormat Type:=xlTypePDF, _
                                        Filename:=sFichierFinal, _
                                        Quality:=xlQualityStandard, _
                                        IncludeDocProperties:=True, _
                                        IgnorePrintAreas:=False, _
                                        OpenAfterPublish:=False
    End If
End Sub

Private Sub Masquer_lignes_120_128()
    Feuil1.Rows("120:128").EntireRow.Hidden = True
End Sub

Sub Masquer_lignes_Vides()
Dim i As Long
    Application.ScreenUpdating = False
    For i = 6 To 119
        If Feuil1.Cells(i, 8).Value = "" Then
            Feuil1.Rows(i).EntireRow.Hidden = True
        End If
    Next i
    Application.ScreenUpdating = True
End Sub

Private Sub Montrer_lignes_120_128()
    Feuil1.Rows("120:128").EntireRow.Hidden = False
End Sub

Sub Montrer_lignes_Vides()
    Feuil1.Cells.EntireRow.Hidden = False
End Sub

Private Function NomFichierValide(sChaine As String) As Boolean
Dim i As Long
Const CaracInterdits As String = """*/:<>?[\]|"

    NomFichierValide = True
    For i = 1 To Len(CaracInterdits)
        If InStr(sChaine, Mid$(CaracInterdits, 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 FSO.FileExists(sDossier & "\" & sNomFichier) Then
        sNouveauNom = sNomFichier
        sPre = FSO.GetBaseName(sNomFichier)
        sExt = FSO.GetExtensionName(sNomFichier)

        i = 0
        While FSO.FileExists(sDossier & "\" & sNouveauNom)
            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

 

[PICOU0510]

Après quelques modifications, j'ai réussi.
Je te remercie pour ton aide.

Cordialement