Appliquer une macro sur une sélection d'onglets

Bonjour le forum,

une fois de plus j'ia besoin de votre aide,

j'ai crée une macro pour enregistrer les onglets séparément en PDF.

Elle fonctionne bien mais j'aimerai pourvoir l’utiliser sur d'autres classeurs en modifiant une petite chose.

Actuellement la macro enregistre à partir de la 3ème feuille jusque la fin,

j'aimerai faire la même chose mais seulement avec les feuilles que j'aurai sélectionné au préalable.

Merci d'avance pour votre aide

Voici mon code :

Sub Enreg_pdf()

Dim Date_application As String, Transporteur As String, Repertoire As FileDialog, i As Integer

Date_application = InputBox("Insérez la date d'application au format AAAA-MM-JJ")

Application.ScreenUpdating = False

With Application.FileDialog(msoFileDialogFolderPicker)
            .Title = "Choix du repertoire"
            .Show

            Set Repertoire = Application.FileDialog(msoFileDialogFolderPicker)

            If Repertoire.SelectedItems.Count > 0 Then

            Else
            MsgBox "Aucun Répertoire Sélectionné"
            Exit Sub
            End If

       End With

For i = 3 To ActiveWorkbook.Sheets.Count
    Transporteur = Sheets(i).Range("A2").Value

    Sheets(i).ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        Repertoire.SelectedItems(1) & "/" & Date_application & "_" & Transporteur & ".pdf", Quality:= _
        xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
        From:=1, To:=1, OpenAfterPublish:=False
Next i

    Application.ScreenUpdating = True

    MsgBox ("Les Feuilles ont été enregistrés dans le dossier suivant : " & Chr(10) & Repertoire.SelectedItems(1))

End Sub

Salut,

Tu peux tester cette macro, mais comme je n'avais pas de fichier à disposition, je n'ai pas pu la tester :

Sub Enreg_pdf()

Dim Date_application As String, Transporteur As String, Repertoire As FileDialog, i As Integer
Dim Sht As Worksheet

Date_application = InputBox("Insérez la date d'application au format AAAA-MM-JJ")

Application.ScreenUpdating = False

With Application.FileDialog(msoFileDialogFolderPicker)
            .Title = "Choix du repertoire"
            .Show

            Set Repertoire = Application.FileDialog(msoFileDialogFolderPicker)

            If Repertoire.SelectedItems.Count > 0 Then

            Else
            MsgBox "Aucun Répertoire Sélectionné"
            Exit Sub
            End If

       End With

For Each Sht In ActiveWindow.SelectedSheets
    Transporteur = Sheets(i).Range("A2").Value

    Sht.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        Repertoire.SelectedItems(1) & "/" & Date_application & "_" & Transporteur & ".pdf", Quality:= _
        xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
        From:=1, To:=1, OpenAfterPublish:=False
Next Sht

    Application.ScreenUpdating = True

    MsgBox ("Les Feuilles ont été enregistrés dans le dossier suivant : " & Chr(10) & Repertoire.SelectedItems(1))

End Sub

Si jamais fournis-moi ton fichier.

Cordialement.

Bonjour,

merci de ta réponse.

La macro ne fonctionne que pour le premier onglet sélectionné ... pas s'il y'en a plusieurs.

J'ai essayé quelques trucs, mais pas réussit ...

Des idées ?

Yvouille a écrit :

Si jamais fournis-moi ton fichier.

Bonjour bonjour,

vous ne connaissez pas un moyen de garder en mémoire la sélection des feuilles ?

Salut,

Grace à ton fichier - il faut toujours fournir son fichier - j'ai découvert mon erreur.

Remplace la ligne

Transporteur = Sheets(i).Range("A2").Value

par

Transporteur = Sht.Range("A2").Value

Cordialement.

Parfait,

cela fonctionne, je n'avais pas vu non plus cette erreur.

MERCI !