Macro boucle dynamique d'impression

Bonjours tout le monde

J'ai besoin de vos aide

Bonjour,

Pour la 1ère partie, ceci devrait faire l'affaire :

Sub test()

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

Pour la 2ème, c'est plus complexe. Tu peux chercher dans les fichiers disponibles sur le site, BrunoM45 a mis à disposition un outil qui peut répondre à ta demande.

bonsoirs

merci pour ce code mais ça marche pas toujours l'imprision est la meme

Bonjour, désolé, je me suis trompé.

J'ai mis [N18] =1 au lieu de [N18] = i

merci

Bonjour à tous,

Voici un essai pour votre second problème en incorporant directement le code de JoyeuxNoel (que je salue !).

Sub test()

dim arrFeuilles()

chemin = thisworkbook.path & "\NOMFICHIER " & format(date, YYMMDD) & ".pdf" '<<< ADAPTER chemin pdf (emplct et nom fichier)

application.screenupdating = false
For i = 1 To WorksheetFunction.Max(Feuil1.Range("A:A")) 'jusqu'au max de A
    Feuil1.copy after:=sheets(sheets.count) 'copie Feuil1 en dernier (<<<ADAPTER Feuil1 ?)
    with activesheet 'avec feuille active, nouvellement créée
        .[N18] = i 'maj valeur N18
        .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
selection.exportasfixedformat type:=xltypepdf, filename:=chemin, ignoreprintareas:=false 'export en pdf
for each ws in worksheets 'pour chaque feuille du classeur
    if ws.index > sheets.count - ubound(arrFeuilles) then 'si la position est supérieure et nombre total de feuilles moins le nombre de feuilles créées (cad, si c'est une copie)
        application.displayalerts = false
        ws.delete 'suppression
        application.displayalerts = true
    end if
next ws
application.screenupdating = true

End Sub

Il faudra peut-être adapter le nom de la feuille de départ (celle à imprimée) identifiée dans le code par son codename Feuil1 et, si le pdf ne donne pas le résultat attendu, peut-être remplacer selection par activesheet à la ligne .exportasfixedformat.

Sinon, il faut que vous définissiez un chemin valide pour l'enregistrement.

Cdlt,

bonsoirs et merci pour le code

Bonsoir,

Il manque un "=" devant le sheets : "after:=sheets(sheets.count)"

bonsoir 3GB , bonsoirs forum

je réussi d'adapter le code afin que l'utilisateur peut choisir l'emplacement de l'enregistrement en indiquant la date de l'enregistrement.

Sub test()

Dim arrFeuilles()
we = WorksheetFunction.Max(Feuil1.Range("A:A"))

chemin = "C:\Users\noura\Desktop\" & Format(Date, YYMMDD) & ".pdf"
'<<< ADAPTER chemin pdf (emplct et nom fichier)

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

mais 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

[s=co-5f497a][/s]

bonsoirs forum

y-a-il d'aide

Bonsoir forum

je besoin de vos aide

Bonsoir le.destin,

Voici un nouvel essai :

Sub test()

Dim arrFeuilles()
we = WorksheetFunction.Max(Feuil1.Range("A:A"))

chemin = "C:\Users\noura\Desktop\"
'<<< ADAPTER chemin pdf (emplct et nom fichier)

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
sDossier = ChoixDossier
if sDossier <> "" then chemin = sDossier & DateF & ".pdf" else chemin = chemin & DateF & ".pdf"
DateF = Format(Date, "_dd-mm-yy")

Sheets(arrFeuilles).Select 'sélectionne les feuilles créées
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

Function ChoixDossier$()
With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Choisir le dossier de destination"
    .InitialFileName = ActiveWorkbook.Path & "\"
    .Show
    If .SelectedItems.Count > 0 Then ChoixDossier = .SelectedItems(1) & "\"
End With
End Function

Bonjour

Merci beaucoup ça marche

Bonjour,

Merci pour ce retour,

Bonne continuation,