Microsoft 365 Sélectionner un ou plusieurs onglets à exporter au format PDF

pat66 à dit:

Est-il possible de pouvoir choisir la ou les feuilles à exporter avant l'exécution de la macro ?

Cliquez pour agrandir...

Private Sub Worksheet_Activate()
    ActiveSheet.ListBox1.Clear
    For Each Feuille In ThisWorkbook.Sheets
        If Feuille.PageSetup.PrintArea <> "" Then ActiveSheet.ListBox1.AddItem Feuille.Name
    Next
End Sub

Nicolas JACQUIN à dit:

Excel cherche une feuille qui s’appelle exactement “Feuil1” (nom d’onglet)

A tester par ce code:

VB:

Dim ListeFeuilles As Collection
Set ListeFeuilles = New Collection

Dim NomF As String
Dim Trouve As Boolean

For i = LBound(TabFeuilles) To UBound(TabFeuilles)

    NomF = TabFeuilles(i)
    Trouve = False

    ' Recherche par nom d'onglet
    For Each Sh In ThisWorkbook.Worksheets
        If LCase(Sh.Name) = LCase(NomF) Then
            ListeFeuilles.Add Sh.Name
            Trouve = True
            Exit For
        End If
    Next Sh

    ' Recherche par CodeName
    If Not Trouve Then
        For Each Sh In ThisWorkbook.Worksheets
            If LCase(Sh.CodeName) = LCase(NomF) Then
                ListeFeuilles.Add Sh.Name
                Trouve = True
                Exit For
            End If
        Next Sh
    End If

    If Not Trouve Then
        MsgBox "Feuille introuvable : " & NomF, vbCritical
        Exit Sub
    End If

Next i

' Conversion collection → tableau
Dim TabSelect() As String
ReDim TabSelect(0 To ListeFeuilles.Count - 1)

For i = 1 To ListeFeuilles.Count
    TabSelect(i - 1) = ListeFeuilles(i)
Next i

Sheets(TabSelect).Select

Cliquez pour agrandir...

Nicolas JACQUIN à dit:

Bonjour, une idée peut-être

VB:

Public NoPrint As Boolean

Private Sub Print_PDF()

    NoPrint = True
    Application.ScreenUpdating = False

    ' Vérification nom patient
    If Sheets("Etude").Range("D22") = "Nom(s)  et  Prénom(s)" Then
        MsgBox "Vous devez préciser le nom du patient!", vbCritical, "Analyses"
        Exit Sub
    End If

    ' ===============================
    'Choix des feuilles à exporter
    ' ===============================
    Dim Choix As String
    Dim TabFeuilles() As String
    Dim i As Integer
    Dim Sh As Worksheet

    Choix = InputBox("Entrez les noms des feuilles à exporter (séparés par des virgules) :" & vbCrLf & _
                     "Exemple : Feuil1,Feuil2,Feuil3")

    If Choix = "" Then Exit Sub

    TabFeuilles = Split(Choix, ",")

    ' Nettoyage des noms
    For i = LBound(TabFeuilles) To UBound(TabFeuilles)
        TabFeuilles(i) = Trim(TabFeuilles(i))
    Next i

    ' Vérification existence feuilles
    On Error GoTo ErreurFeuille
    Sheets(TabFeuilles).Select
    On Error GoTo 0

    ' ===============================
    'Paramétrage impression
    ' ===============================
    For Each Sh In ActiveWindow.SelectedSheets

        With Sh.PageSetup
            .Zoom = False
            .FitToPagesWide = 1
            .FitToPagesTall = 1

            .LeftMargin = Application.InchesToPoints(0.1)
            .RightMargin = Application.InchesToPoints(0.1)
            .TopMargin = Application.InchesToPoints(1)
            .BottomMargin = Application.InchesToPoints(0.1)

            .Orientation = xlLandscape
        End With

    Next Sh

    ' ===============================
    'Nom du fichier
    ' ===============================
    Dim NFichier As String
    NFichier = Sheets(TabFeuilles(0)).Range("D20") & "-" & _
               Sheets(TabFeuilles(0)).Range("D22") & "-" & _
               Format(Date, "dd-mm-yyyy")

    ' ===============================
    'Export PDF
    ' ===============================
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
        Filename:=ThisWorkbook.Path & "\" & NFichier, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=True

    ' Retour sur première feuille
    Sheets(TabFeuilles(0)).Select

    MsgBox "Le PDF a été enregistré !" & vbCrLf & vbCrLf & _
           "Ici ==> " & ThisWorkbook.Path & vbCrLf & vbCrLf & _
           "Sous le nom : " & NFichier & ".pdf", 64, "Analyses"

    Application.ScreenUpdating = True
    NoPrint = False
    Exit Sub

' ===============================
' Gestion erreur
' ===============================
ErreurFeuille:
    MsgBox "Une ou plusieurs feuilles n'existent pas !" & vbCrLf & _
           "Vérifiez les noms saisis.", vbCritical
    Application.ScreenUpdating = True
    NoPrint = False

End Sub

Nicolas

Cliquez pour agrandir...