XL 2016 Bouton pour Impression de plusieurs fuilles excel dans le même fichier pdf par exempe

[kamal.elkakiri]

Bonjour
En utilisant le code ci-dessous, j'arrive à choisir la ou les pages que je veux imprimer ( en pdf) dans mon fichier Excel par contre ce que je n'arrive pas à faire, c'est de les avoir de même fichier PDF.
Je suis obligé d'enregistrer deux feuilles distinctes avec deux noms différents si je sélectionne deux feuilles à imprimer:

Voici le code que j'utilise et que j'ai récupéré sur ce forum ( merci par ailleurs):

Private Sub CommandButton2_Click()
Dim i As Integer
Dim TopPos As Integer
Dim SheetCount As Integer
Dim PrintDlg As DialogSheet
Dim CurrentSheet As Worksheet
Dim cb As CheckBox
Application.ScreenUpdating = False

' Check for protected workbook
If ActiveWorkbook.ProtectStructure Then
MsgBox "Le classeur est protégé.", vbCritical
Exit Sub
End If

' Add a temporary dialog sheet
Set CurrentSheet = ActiveSheet
Set PrintDlg = ActiveWorkbook.DialogSheets.Add

SheetCount = 0

' Add the checkboxes

TopPos = 40
For i = 1 To ActiveWorkbook.Worksheets.Count
Set CurrentSheet = ActiveWorkbook.Worksheets(i)
' Skip empty sheets and hidden sheets
If Application.CountA(CurrentSheet.Cells) <> 0 And _
CurrentSheet.Visible Then
SheetCount = SheetCount + 1
PrintDlg.CheckBoxes.Add 78, TopPos, 150, 16.5
PrintDlg.CheckBoxes(SheetCount).Text = _
CurrentSheet.Name
TopPos = TopPos + 13
End If
Next i

' Move the OK and Cancel buttons
PrintDlg.Buttons.Left = 240

' Set dialog height, width, and caption
With PrintDlg.DialogFrame
.Height = Application.Max _
(68, PrintDlg.DialogFrame.Top + TopPos - 34)
.Width = 230
.Caption = "Cochez les feuilles à imprimer."

End With

' Change tab order of OK and Cancel buttons
' so the 1st option button will have the focus
PrintDlg.Buttons("Button 2").BringToFront
PrintDlg.Buttons("Button 3").BringToFront

' Display the dialog box
CurrentSheet.Activate
Application.ScreenUpdating = True
If SheetCount <> 0 Then
If PrintDlg.Show Then
For Each cb In PrintDlg.CheckBoxes
If cb.Value = xlOn Then
Worksheets(cb.Caption).Activate
ActiveSheet.PrintOut
' ActiveSheet.PrintPreview 'for debugging

End If
Next cb
End If
Else
MsgBox "Toutes les feuilles sont vides."
End If

' Delete temporary dialog sheet (without a warning)
Application.DisplayAlerts = False
PrintDlg.Delete

' Reactivate original sheet
CurrentSheet.Activate
End Sub

 

[kiki29]

Salut, va voir ici puis adapte à ton contexte.

Possibilité de fusion en 1 seul pdf de l'ensemble des feuilles, ou de génération des feuilles sélectionnées de façon séparée, de gestion des doublons via un indice, le tout dans un dossier créé automatiquement et nommé par défaut Dossier PDFs à la racine de l'application. L'ensemble des feuilles ( visibles ou pas ) est listé via le bouton Récap.

 

[kamal.elkakiri]

Bonjour
Merci pour votre réponse mais cela me semble une solution plus complexe que ce que j'ai
Jetez un coup d’œil sur ce fichier, la solution est presque parfaite.
Essayez d’imprimer la première page en cliquant sue l’imprimante
il ne manque que le fusion des pages imprimées

 

[kiki29]

Re, n'étant pas un partisan du tout cuit, tu as les sources des 2 applis, à toi de les fusionner/élaguer etc, voir pj pour pdf fusionné via ton appli modifiée avec mon code, bref à toi d’œuvrer ...

 

[kamal.elkakiri]

Bonjour Kiki29
Vous avez bien je peux fusionner cela même en faisant une impression banale sur PDF et ensuite je sélectionne ce que je veux fusionner et dans quel ordre et ensuite le tour est joué.
Ce que je cherche c'est de voir comment améliorer le code que j'ai partagé afin de voir les pages sélectionnées sur le même fichier et ce sans repartir sur pdf et faire une fusion/.
Je comprends que tu ne sois pas partisan de certaines choses et cela est votre droit.
J'attends de voir d'autres réponses.
Merci

 

[kiki29]

Re, visiblement tu n'as rien compris au code fourni dans l'appli Impression_Onglets, moi je laisse tomber.

 

[fanch55]

Bonjour,
Comme promis sur l'autre fil, je vous donne la solution.
Je partage l'avis de @kiki29 ( bien que son code s'adresse déjà à des personnes avancées dans les macros), vous auriez pu trouver tout seul :

Voici donc un code "tout cuit" à placer sur la feuille ou se trouve votre bouton imprimante:

Option Explicit
Private Sub CommandButton2_Click()
Dim PrintDlg        As DialogSheet
Dim CurrentSheet    As Worksheet
Dim Sh              As Worksheet
Dim Cb              As CheckBox
Dim Sel_Sheets      As String
Dim FileName        As Variant
Dim TopPos          As Integer

Application.ScreenUpdating = False

    ' Check for protected workbook
    If ActiveWorkbook.ProtectStructure Then
        MsgBox "Le classeur est protégé.", vbCritical
        Exit Sub
    End If

    ' Add a temporary dialog sheet
    Set CurrentSheet = ActiveSheet
    Set PrintDlg = ActiveWorkbook.DialogSheets.Add

    ' Add the checkboxes
    TopPos = PrintDlg.Buttons(1).Top
    For Each Sh In ActiveWorkbook.Worksheets
        ' Skip hidden sheets
        If Sh.Visible Then
           PrintDlg.CheckBoxes.Add(78, TopPos, 100, 16.5).Text = Sh.Name
           TopPos = TopPos + 13
        End If
    Next
    
    ' Move the OK and Cancel buttons
    PrintDlg.Buttons.Left = PrintDlg.CheckBoxes(1).Left + PrintDlg.CheckBoxes(1).Width
    
    ' Set dialog height, width, and caption
    With PrintDlg.DialogFrame
        .Height = Application.Max(68, PrintDlg.DialogFrame.Top + TopPos - 34)
        .Width = PrintDlg.Buttons(1).Left ' <-- bizarre mais fonctionne
        .Caption = "Cochez les feuilles à publier"
    End With
    
    ' Set focus on Cancel
    PrintDlg.Buttons(1).BringToFront
    
    ' Display the dialog box
    CurrentSheet.Activate
    Application.ScreenUpdating = True
        If PrintDlg.Show Then
            For Each Cb In PrintDlg.CheckBoxes
                If Cb.Value = xlOn Then Sel_Sheets = Trim(Sel_Sheets & " " & Cb.Caption)
            Next Cb
            If Sel_Sheets <> vbNullString Then
               ' Display the dialog box to obtain filename
                FileName = Application.GetSaveAsFilename( _
                    FileFilter:="Publication (*.pdf),*.pdf", _
                    InitialFileName:=ThisWorkbook.Path)
                If Not FileName = False Then
                    ' Select sheets to export
                    Sheets(Split(Sel_Sheets)).Select
                    ' Publication
                    ActiveSheet.ExportAsFixedFormat _
                        Type:=xlTypePDF, OpenAfterPublish:=True, _
                        FileName:=FileName
                End If
            End If
        End If

    ' Delete temporary dialog sheet (without a warning)
    Application.DisplayAlerts = False
    PrintDlg.Delete

' Reactivate original sheet
CurrentSheet.Activate
Set CurrentSheet = Nothing
Set PrintDlg = Nothing

End Sub

 

[kamal.elkakiri]

Re, visiblement tu n'as rien compris au code fourni dans l'appli Impression_Onglets, moi je laisse tomber.

Je ne comprends pas tu es agressif comme ça?

 

[kamal.elkakiri]

Bonjour,
Comme promis sur l'autre fil, je vous donne la solution.
Je partage l'avis de @kiki29 ( bien que son code s'adresse déjà à des personnes avancées dans les macros), vous auriez pu trouver tout seul :

Voici donc un code "tout cuit" à placer sur la feuille ou se trouve votre bouton imprimante:

Option Explicit
Private Sub CommandButton2_Click()
Dim PrintDlg        As DialogSheet
Dim CurrentSheet    As Worksheet
Dim Sh              As Worksheet
Dim Cb              As CheckBox
Dim Sel_Sheets      As String
Dim FileName        As Variant
Dim TopPos          As Integer

Application.ScreenUpdating = False

    ' Check for protected workbook
    If ActiveWorkbook.ProtectStructure Then
        MsgBox "Le classeur est protégé.", vbCritical
        Exit Sub
    End If

    ' Add a temporary dialog sheet
    Set CurrentSheet = ActiveSheet
    Set PrintDlg = ActiveWorkbook.DialogSheets.Add

    ' Add the checkboxes
    TopPos = PrintDlg.Buttons(1).Top
    For Each Sh In ActiveWorkbook.Worksheets
        ' Skip hidden sheets
        If Sh.Visible Then
           PrintDlg.CheckBoxes.Add(78, TopPos, 100, 16.5).Text = Sh.Name
           TopPos = TopPos + 13
        End If
    Next
   
    ' Move the OK and Cancel buttons
    PrintDlg.Buttons.Left = PrintDlg.CheckBoxes(1).Left + PrintDlg.CheckBoxes(1).Width
   
    ' Set dialog height, width, and caption
    With PrintDlg.DialogFrame
        .Height = Application.Max(68, PrintDlg.DialogFrame.Top + TopPos - 34)
        .Width = PrintDlg.Buttons(1).Left ' <-- bizarre mais fonctionne
        .Caption = "Cochez les feuilles à publier"
    End With
   
    ' Set focus on Cancel
    PrintDlg.Buttons(1).BringToFront
   
    ' Display the dialog box
    CurrentSheet.Activate
    Application.ScreenUpdating = True
        If PrintDlg.Show Then
            For Each Cb In PrintDlg.CheckBoxes
                If Cb.Value = xlOn Then Sel_Sheets = Trim(Sel_Sheets & " " & Cb.Caption)
            Next Cb
            If Sel_Sheets <> vbNullString Then
               ' Display the dialog box to obtain filename
                FileName = Application.GetSaveAsFilename( _
                    FileFilter:="Publication (*.pdf),*.pdf", _
                    InitialFileName:=ThisWorkbook.Path)
                If Not FileName = False Then
                    ' Select sheets to export
                    Sheets(Split(Sel_Sheets)).Select
                    ' Publication
                    ActiveSheet.ExportAsFixedFormat _
                        Type:=xlTypePDF, OpenAfterPublish:=True, _
                        FileName:=FileName
                End If
            End If
        End If

    ' Delete temporary dialog sheet (without a warning)
    Application.DisplayAlerts = False
    PrintDlg.Delete

' Reactivate original sheet
CurrentSheet.Activate
Set CurrentSheet = Nothing
Set PrintDlg = Nothing

End Sub

Merci beaucoup, ton code fonctionne parfaitement