XL 2019 Enregistre les page a imprimer dans un seul fichier pdf

[le___destin]

Bonsoir tout le monde
Mercie m'aide d'améliorer mon code pour que tout les page soit en registre dans un meme fichier .pdf

Sub test()

For i = 1 To WorksheetFunction.Max(Feuil1.Range("A:A"))
[N18] = i
ActiveSheet.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
Next
End Sub

 

[kiki29]

Re, tu as déjà eu des réponses à ton problème ici

 

[le___destin]

Bonsoirs forum
je réussi d'adapter un code afin que l'utilisateur peut choisir l'emplacement de l'enregistrement de mon fichier pdf en indiquant la date de l'enregistrement.

Sub test()

Dim arrFeuilles()
we = WorksheetFunction.Max(Feuil1.Range("A:A"))
Application.ScreenUpdating = True
For i = 1 To we 'jusqu'au max de A
    Feuil2.Copy after:=Sheets(Sheets.Count)   'copie Feuil1 en dernier (<<<ADAPTER Feuil1 ?)
    With ActiveSheet 'avec feuille active, nouvellement créée
        [N18] = i 'maj valeur N18
        [J11] = [J18]
        'PrintOut Copies:=1, Collate:=True, ignoreprintareas:=False 'impression
        ReDim Preserve arrFeuilles(1 To i) 'redimension tableau de stockage des noms
        arrFeuilles(i) = .Name 'item i stocke nom feuille
    End With
Next i
Sheets(arrFeuilles).Select 'sélectionne les feuilles créées
DateF = Format(Date, "_dd-mm-yy")
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ChoixDossier & DateF, Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
        True
        Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete
  Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

à l'aide de la fonction ChoixDossier

Function ChoixDossier()
    If Val(Application.Version) >= 10 Then
       With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Choisir le dossier de destination"
        .InitialFileName = ActiveWorkbook.Path & "\"
        .Show
        If .SelectedItems.Count > 0 Then
           ChoixDossier = .SelectedItems(1)
        Else
           ChoixDossier = ""
        End If
       End With
     Else
       ChoixDossier = InputBox("Répertoire?")
     End If
End Function

mon problème est que le fichier enregistre avec le nom de dossier répertoire .. quelqu'un peut-il modifier le code de fonction affin que l'utilisateur à le droit de choisir le nom du fichier enregistré

et merci d'avance