XL 2016 *** RESOLU MERCI :)*** Impression personnalisée.

gosselien à dit:

Je ne fais que passer 2 min puisque je ne sais pas plus mais il me semble que mon code scindait tes données dans un onglet export et une seconde macro imprimait pour chaque date ou groupe de date...
Tu peux me dire ce qui n'allait pas avec ça ? Merci

Cliquez pour agrandir...

Agecanonix35400 à dit:

J'ai cliqué sur imprimé sur le 1er onglet mais je n'ai qu'une page à imprimer.
Sur le 2ème onglet je n'ai qu'un seul jour à imprimer, après faut que je selectionne le tout 1 par 1
Sur le 3ème onglet je n'ai rien à imprimer.

Cliquez pour agrandir...

If ActiveSheet.Name <> "Feuille pour factu" Then Exit Sub

TooFatBoy à dit:

Si tu as plusieurs feuilles dans ton classeur qui utilisent la macro, alors il faut modifier cette ligne :

VB:

If ActiveSheet.Name <> "Feuille pour factu" Then Exit Sub

As-tu réussi à le faire ?

Cliquez pour agrandir...

TooFatBoy à dit:

Si tu as plusieurs feuilles dans ton classeur qui utilisent la macro, alors il faut modifier cette ligne :

VB:

If ActiveSheet.Name <> "Feuille pour factu" Then Exit Sub

As-tu réussi à le faire ?

Cliquez pour agrandir...

Agecanonix35400 à dit:

C'était pour Gosselin et l'exemple de macros qu'il avait fait.

Cliquez pour agrandir...

TooFatBoy à dit:

J'ai peut-être réussi... à faire ce que je voulais.
Peux-tu tester, stp ?

VB:

Sub Impression()
' Exemple d'ajout d'un saut de page : ActiveSheet.HPageBreaks.Add Before:=Range("A3")
Dim TS As Object
Dim MesDates As Range, NewCel As Range, OldCel As Range

    ' Si la feuille active au moment d'imprimer ne s'appelle pas "Feuille pour factu", alors on abandonne la macro
    If ActiveSheet.Name <> "Feuille pour factu" Then Exit Sub

    ' Assignation de TS : tableau complet (sans les en-têtes)
    Set TS = ActiveSheet.ListObjects(1)
    ' Assignation de MesDates : toutes les cellules visibles de la deuxième colonne du tableau
    Set MesDates = TS.ListColumns(2).DataBodyRange.SpecialCells(xlCellTypeVisible)

    ' Supprime tous les sauts de page de la feuille active
    ActiveSheet.ResetAllPageBreaks

    ' Assignation de Debut à True
    Debut = True

    ' Pour chaque cellule visible de la deuxième colonne du tableau
    For Each NewCel In MesDates
        ' Si Debut = True alors...
        If Debut Then
            ' Assignation de OldCel
            Set OldCel = NewCel
            ' Assignation de Debut à False, pour ne pas repasser dans cette partie du For...Next
            Debut = False
        Else
            ' Si la valeur de la cellule visible n'est pas identique à celle de la cellule visible au-dessus...
            If NewCel <> OldCel Then
                ' on ajoute un saut de page
                ActiveSheet.HPageBreaks.Add Before:=NewCel
            ' Fin de Si
            End If
            ' Assignation de OldCel
            Set OldCel = NewCel
        ' Fin de Si
        End If
    ' Passage à la cellule suivante
    Next

    ' Configuration pour imprimer l'en-tête sur chaque page
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = TS.HeaderRowRange.Address
        .PrintTitleColumns = ""
    End With
    Application.PrintCommunication = True

    ActiveSheet.PrintPreview

End Sub

Cliquez pour agrandir...

Agecanonix35400 à dit:

Salut, désolé de te redéranger pour cela mais serait-il possible d'y apporter une petite modif stp.... Est-il possible de n'avoir qu’un jour par feuille ?
Dans la macro donnée on change de page à la fin de chaque jour.
Je ne sais pas si je me fais bien comprendre. par exemple:
le 1er je l'ai sur la page 1,
le 2 je l'ai sur la page 2.
Serait-il possible d'avoir le 1er sur la feuille 1 et le 2 sur la feuille 2?

SI cela est trop compliqué, t'inquiète pas je me débrouille. 😉

Cliquez pour agrandir...

Agecanonix35400 à dit:

SI cela est trop compliqué, t'inquiète pas je me débrouille. 😉

Cliquez pour agrandir...

TooFatBoy à dit:

Il faudrait sûrement configurer l'impression en mode simple face, ce qui n'est déjà pas très simple pour moi... mais ça risque de ne pas être bon car dans ce si jamais tu as un jour sur deux pages il va du coup s'imprimer sur deux feuilles.

Je regarde ça dans la journée si j'ai le temps, sinon cette nuit.

Cliquez pour agrandir...

Agecanonix35400 à dit:

Mais il est vrai que je voudrais un jour par feuille et si le jour a besoin de deux pages, j'aimerais que cela imprime en verso. Donc t'inquiète c'est déjà très bien

Cliquez pour agrandir...

TooFatBoy à dit:

Ta demande d'évolution doit être réalisable, mais je ne suis pas bien doué donc ça va me demander pas mal de temps.
C'est un challenge pour moi, mais j'aime ça ! 👍

Cliquez pour agrandir...

Agecanonix35400 à dit:

Si chatgpt trouve la solution, on sait jamais, veux-tu que je te la partage?

Cliquez pour agrandir...

TooFatBoy à dit:

Oui, il faudrait la partager car c'est bien là le principe d'un forum : on pose une question et si on a une solution on la partage (même si elle vient d'une de ces cochonneries de soi-disant "intelligence" artificielle).

Cliquez pour agrandir...

Sub ImpressionRectoJour_Stable()
    Dim TS As ListObject
    Dim MesDates As Range, NewCel As Range, OldCel As Range
    Dim Debut As Boolean
    Dim ws As Worksheet
    Dim PlageJour As Range
    Dim DebutJour As Long, FinJour As Long
    Dim dlgResult As Boolean

    ' Vérifie la feuille
    Set ws = ActiveSheet
    If ws.Name <> "Feuille pour factu" Then Exit Sub

    ' Récupère le tableau et les cellules visibles de la colonne 2
    Set TS = ws.ListObjects(1)
    On Error GoTo ErrNoVisible
    Set MesDates = TS.ListColumns(2).DataBodyRange.SpecialCells(xlCellTypeVisible)
    On Error GoTo 0

    ' --- Configuration de l'impression (avant boîte d'impression) ---
    With ws.PageSetup
        .PrintTitleRows = TS.HeaderRowRange.Address
        .PrintTitleColumns = ""
        .CenterHorizontally = True
        .CenterVertically = False
    End With

    ' --- Ouvre le panneau d'impression pour choisir l'imprimante ---
    dlgResult = Application.Dialogs(xlDialogPrinterSetup).Show
    If dlgResult = False Then
        MsgBox "Sélection d'imprimante annulée. Aucune impression lancée.", vbInformation
        Exit Sub
    End If

    ' Supprime les anciens sauts de page
    ws.ResetAllPageBreaks

    ' --- Impression jour par jour ---
    Debut = True
    DebutJour = 0

    For Each NewCel In MesDates
        If Debut Then
            Set OldCel = NewCel
            DebutJour = NewCel.Row
            Debut = False
        Else
            If NewCel.Value <> OldCel.Value Then
                ' Impression du jour précédent
                FinJour = OldCel.Row
                Set PlageJour = ws.Rows(DebutJour & ":" & FinJour)
                PlageJour.PrintOut

                ' Ajout d'un saut de page avant le nouveau jour pour forcer le recto
                ws.HPageBreaks.Add Before:=ws.Rows(NewCel.Row)

                ' Nouveau jour
                DebutJour = NewCel.Row
                Set OldCel = NewCel
            Else
                Set OldCel = NewCel
            End If
        End If
    Next NewCel

    ' Impression du dernier jour
    If DebutJour > 0 Then
        FinJour = OldCel.Row
        Set PlageJour = ws.Rows(DebutJour & ":" & FinJour)
        PlageJour.PrintOut
    End If

    MsgBox "Impression terminée : chaque jour commence sur un recto.", vbInformation
    Exit Sub

ErrNoVisible:
    MsgBox "Aucune cellule visible trouvée dans la 2ème colonne du tableau.", vbExclamation
End Sub