Macro saut de page adaptable selon dates TCD

**safranien** · 19/07/2020, 13h10

Bonjour

je dispose d'un fichier qui rècupère des dates et données journalières sur un serveur. Sur une feuille, j'ai TCD reprenant ces données. Ces données peuvent débuter à n'importe quelle date mais ce sera toujours le 1er du mois qui sera la première date (01/01/20XX ou 01/03/XX etc). Dans tous les cas, au final, j'aurai toujours un tableau comportant des données pour 365 ou 366 jours au final. Mon TCD va donc s'agrandir au fur et à mesure et dès que je passe une certaine date je dois réarranger les sauts de page.
N'y aurait-il pas une possibilité de déclarer que le premier saut de page doit être au niveau de la ligne qui sera le dernier jour du 4e mois après la première date des données puis un autre saut de ligne qui se mettra 4 mois plus tard et enfin encore 4 mois plus tard?

Dans mon exemple, mes données débutent au 01/01/2020. Il faudrait donc que le premier saut de ligne se positionne au niveau de la ligne qui accueillera la date du 30/04 (ligne qui va varier selon que l'on est en année bissextile ou non).
Le 2e saut de page devra apparaître dès lors que les dates du TCD auront dépasser le 30/04 pour aller se positionner 4 mois plus tard, soit au niveau de la ligne qui accueillera la date du 31/08.
Idem ensuite pour le 31/12.

Ceci est un exemple pour un début au 01/01 mais la logique est la même si je passe sur une affaire dont les données débutent par exemple au 01/03/XX. Les sauts de lignes devront alors se faire au 30/06/XX - 31/10/XX - 28 ou 29/02/XX+1.

Merci d'avance pour votre aide.

**ARTURO83** · 20/07/2020, 08h09

Bonjour,

Voici une proposition à adapter, supprimez tout d'abord la zone d'impression, puis copiez le code dans un module standard

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Dim Annee As Long
Dim Date1 As Date, d1 As Range
 
Sub fixer_Sauts_de_Pages()
    Application.ScreenUpdating = False
    Annee = Year(Range("B2").Value)
    Date1 = DateSerial(Annee, "04", "30")    'Recherche du 30/04
    Marquage_Saut_de_Page
    Date1 = DateSerial(Annee, "06", "30")    'Recherche du 30/06
    Marquage_Saut_de_Page
    Date1 = DateSerial(Annee, "10", "31")    'Recherche du 31/10
    Marquage_Saut_de_Page
    If Annee Mod 4 = 0 Then
        Date1 = DateSerial(Annee + 1, "02", "28")  'Recherche du 28/02
    Else
        Date1 = DateSerial(Annee + 1, "02", "29")  'Recherche du 29/02
    End If
    Marquage_Saut_de_Page
End Sub
 
Sub Marquage_Saut_de_Page()
    Set d1 = Columns("F").Find(Date1, LookIn:=xlFormulas, lookat:=xlWhole)
    Range(Cells(d1.Row + 1, "F"), Cells(d1.Row + 1, "DZ")).Select
    ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell
End Sub

Cdlt

**safranien** · 20/07/2020, 10h03

Bonjour Arturo83

merci beaucoup pour ta proposition. J'ai collé le code dans un module et fait varier mon TCD. Les saut de page horizontaux semblent bien suivre ce dernier. Cependant, la zone d'impression commence en A0 jusqu'en DZ1. J'aimerais qu'elle commence en B1 jusqu'en CO1 comme dans le fichier que j'ai envoyé. De plus, je me retrouve avec plusieurs sauts de pages verticaux ce qui me donne au fnal 22 pages. J'ai voulu réarranger les sauts de pages verticaux mais après la macro ne fonctionne plus.

Dernier point, la première date de mon TCD ne sera pas forcément le 1er janvier. Plutôt que de chercher les 30/04, 30/06 et 31/10 dans le code, peut on chercher le dernier jour du 4e mois suivant la première date du TCD, puis le 8e etc?
Par exemple si la première date = 01/11/2019 alors le premier saut de page doit être au 28 ou 29 février 2020, puis au 30/06/2020 et enfin au 31/10/2020?

**ARTURO83** · 20/07/2020, 11h45

Dernier point, la première date de mon TCD ne sera pas forcément le 1er janvier. Plutôt que de chercher les 30/04, 30/06 et 31/10 dans le code, peut on chercher le dernier jour du 4e mois suivant la première date du TCD, puis le 8e etc?
Par exemple si la première date = 01/11/2019 alors le premier saut de page doit être au 28 ou 29 février 2020, puis au 30/06/2020 et enfin au 31/10/2020?

Vous vous contredisez ou alors j'ai mal compris, initialement c'était:

Ces données peuvent débuter à n'importe quelle date mais ce sera toujours le 1er du mois qui sera la première date (01/01/20XX ou 01/03/XX etc)

PPOur le choix des dates, créez un boîte de dialogue qui demande de saisir la première date, et appliquez le décalage pour les périodes suivantes.

Ici le code modifié qui crée une zone d'impression différente au fur et à mesure de son avancement, à adapter selon vos besoins

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
    Dim DerLig As Long
    Dim LigDeb As Long
    Dim Date1, d1 As Object
    Dim Plage As Range
    Dim Annee As Long
 
Sub fixer_Sauts_de_Pages()
    Application.ScreenUpdating = False
    Annee = Year(Range("B2").Value)
    Date1 = DateSerial(Annee, "04", "30")    'Recherche du 30/04
    Marquage_Saut_de_Page
    LigDeb = 1
    Set Plage = Range(Cells(LigDeb, "B"), Cells(DerLig, "CO"))
    Definir_Zone_Impression
    'inscrivez ici votre ligne d'impression
 
    Date1 = DateSerial(Annee, "06", "30")    'Recherche du 30/06
    LigDeb = DerLig + 1
    Marquage_Saut_de_Page
    Set Plage = Range(Cells(LigDeb, "B"), Cells(DerLig, "CO"))
    Definir_Zone_Impression
    'inscrivez ici votre ligne d'impression
 
 
    Date1 = DateSerial(Annee, "10", "31")    'Recherche du 31/10
    LigDeb = DerLig + 1
    Marquage_Saut_de_Page
    Set Plage = Range(Cells(LigDeb, "B"), Cells(DerLig, "CO"))
    Definir_Zone_Impression
     'inscrivez ici votre ligne d'impression
 
 
    Marquage_Saut_de_Page
    If Annee Mod 4 = 0 Then
        Date1 = DateSerial(Annee + 1, "02", "28")  'Recherche du 28/02
    Else
        Date1 = DateSerial(Annee + 1, "02", "29")  'Recherche du 29/02
    End If
    LigDeb = DerLig + 1
    Marquage_Saut_de_Page
    Set Plage = Range(Cells(LigDeb, "B"), Cells(DerLig, "CO"))
    Definir_Zone_Impression
    'inscrivez ici votre ligne d'impression
 
End Sub
 
Sub Marquage_Saut_de_Page()
    Set d1 = Columns("F").Find(Date1, LookIn:=xlFormulas, lookat:=xlWhole)
    Range(Cells(d1.Row + 1, "A"), Cells(d1.Row + 1, "CO")).Select
    ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell
    DerLig = Selection.Row - 1
End Sub
 
Sub Definir_Zone_Impression()
    On Error Resume Next
    ActiveWorkbook.Names("zone_d_impression").Delete
    Plage.Select
    ActiveWorkbook.Names.Add Name:="zone_d_impression", RefersToR1C1:="=Feuil1!R" & LigDeb & "C2:R" & DerLig & "C2"
End Sub

**safranien** · 20/07/2020, 22h51

Bonsoir

désolé j'ai du mal m'exprimer. Quand je dis que la première date sera toujours le 1er du mois...de n'importe quel mois. Effectivement derrière j'ai refais mention du 1er janvier, j'aurais du mettre le 01/11/2019 par exemple.
J'aurais du dire aussi que je n'y connaissais rien en macro et que du coup je suis un boulet pour des gens expérimentés comme vous.
Créer une boite de dialogue je ne sais pas faire et dans tous les cas, j'aimerais que tout soit automatisé. J'ai dans mon fichier plus d'une centaine de sites que je choisis via un menu déroulant, et qui ont tous des dates de démarrage différentes. Je ne peux pas faire une action manuelle de déclarration de date de départ à chaque fois.
J'ai malgré tout tenté de recopier le dernier code et le résultat n'y est pas. Le dernier saut de page semble bien suivre les mises à jours du TCD mais les sauts de pages intermédiaires ne sont plus calés au bon endroit (dans notre exemple, au 30/04 et au 31/08 quand je chois le cas 3).
De plus, la zone imprimable du fichier devrait être de B2 à CO2, jusqu'au saut de page du bas et là le 1er saut de page du haut est en A1. Et dernier point, il y a des sauts de pages verticaux intermédiaires alors qu'il ne devrait pas y en avoir.

Peut être que je fais mal qqch. Si ça fonctionne chez vous, pouvez vous me renvoyer le fichier avec votre code? Je continue d'essayer de comprendre et de chercher comment faire.

Bonne soirée.

**ARTURO83** · 21/07/2020, 08h57

Bonjour,

Essayez ceci: au début, une boîte de dialogue vous demandera de saisir le nombre de mois.

le fichier
Pièce jointe 575475

le code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
    Dim DerLig As Long
    Dim LigDeb As Long
    Dim Date1, d1 As Object
    Dim Plage As Range
    Dim Annee As Long, i As Long
    Dim DateDepart As Date
    Dim NbMois As Byte, NbM As Byte
 
Sub fixer_Sauts_de_Pages()
    Application.ScreenUpdating = False
    Annee = Year(Range("B2").Value)
    DateDepart = Range("F5")
    NbMois = Application.InputBox("Inscrivez le nombre de mois par page", , , , , , , 1)
    DerLig = 0
    For i = 1 To (12 / NbMois)
        NbM = (NbMois * i) - 1
        Date1 = CDate(Application.WorksheetFunction.EoMonth(DateDepart, NbM))
        LigDeb = DerLig + 1
        Marquage_Saut_de_Page
        Set Plage = Range(Cells(LigDeb, "B"), Cells(DerLig, "CO"))
        Definir_Zone_Impression
 
        'inscrivez ici votre ligne d'impression
 
    Next i
End Sub
 
Sub Marquage_Saut_de_Page()
    If i = 4 Then
        DerLig = Range("F" & Rows.Count).End(xlUp).Row
    Else
        DerLig = Columns("F").Find(Date1, LookIn:=xlFormulas, lookat:=xlWhole).Row
    End If
End Sub
 
Sub Definir_Zone_Impression()
    On Error Resume Next
    ActiveSheet.PageSetup.PrintArea = "B" & LigDeb & ":CO" & DerLig
    ActiveSheet.HPageBreaks(1).DragOff Direction:=xlDown, RegionIndex:=1
    ActiveWorkbook.Names("zone_d_impression").Delete
    Plage.Select
    ActiveWorkbook.Names.Add Name:="zone_d_impression", RefersToR1C1:="=Feuil1!R" & LigDeb & "C2:R" & DerLig & "C93"
End Sub

Cdlt

Macro saut de page adaptable selon dates TCD

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager