Problème ligne lors de construction tableau

**altra** · 11/08/2009, 11h54

Bonjour le forum

J'ai un petit probleme avec une petite ligne.
Grâce à une macro je crée un tableau en fonction du nombre de jours dans le mois.

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
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
Sub construction_tableau()
Dim i As Integer
Dim dteDate As Date
Dim NbJourDansMois As Integer
Dim Nbligne As Integer
Dim lignefin As Integer
 
 
'détermine le nombre de jours dans le mois en cours
    Select Case (Month(Date))
        'Avril, Juin, Septembre, Novembre
        Case 4, 6, 9, 11
            NbJourDansMois = 30
        ' Février
        Case 2
            ' Si Divisible par 400 alors Bisextile
            If (Year(Date) Mod 4 = 0) And (Year(Date) Mod 100 <> 0) Or (Year(Date) Mod 400 = 0) Then
                NbJourDansMois = 29
            Else
                NbJourDansMois = 28
            End If
        ' Les autres mois
        Case Else
            NbJourDansMois = 31
    End Select
 
 
'pour connaitre la derniere ligne utilisée dans la colonne A
DerniereLigne = Cells(Columns(1).Cells.Count, 1).End(xlUp).Row
 
'efface toute la plage de cellule nécessaire à la construction du tableau, utile lors du passage d'un mois à l'autre pour effacer la dernière ligne
Range(Cells(5, 1), Cells(96, 23)).EntireRow.Delete
 
'met la colonne A au format 01-août-09
Columns("A:A").NumberFormat = "[$-40C]dd-mmm-yy;@"
 
 
dteDate = "01/" & Month(Date) & "/" & Year(Date) 'variable qui contient la date actuelle et commence au premier jour du mois
 
'cette boucle permet d'afficher la date dans la 1ere colonne et d'incrémenter le jour du mois jusqu'à la fin du mois
    For i = 6 To ((NbJourDansMois * 3) + 3)
 
        Cells(i, 1).Value = dteDate
        dteDate = DateAdd("D", 1, dteDate) 'incremente la jour de 1
        i = i + 2 'pour écrire la date 1 ligne sur 3
 
    Next i
 
'cette boucle permet la construction de la mise en forme du tableau
 
    For i = 5 To ((NbJourDansMois * 3) + 3)
 
'pour signaler le quart
        Cells(i, 2).Value = "M"
        Cells(i + 1, 2).Value = "S"
        Cells(i + 2, 2).Value = "N"
 
'quadrille et centre les données
    With Range(Cells(i, 2), Cells(i + 2, 23))
        .HorizontalAlignment = xlCenter
        .Borders(xlEdgeLeft).Weight = xlThin
        .Borders(xlEdgeRight).Weight = xlThin
        .Borders(xlEdgeTop).Weight = xlThin
        .Borders(xlEdgeBottom).Weight = xlThin
        .Borders(xlInsideVertical).Weight = xlThin
        .Borders(xlInsideHorizontal).Weight = xlThin
    End With
 
'encadre toute la zone assignée à une date avec des traits gras
    With Range(Cells(i, 1), Cells(i + 2, 23))
        .Borders(xlEdgeLeft).Weight = xlMedium
        .Borders(xlEdgeRight).Weight = xlMedium
        .Borders(xlEdgeTop).Weight = xlMedium
        .Borders(xlEdgeBottom).Weight = xlMedium
    End With
 
'ajoute des pointillés sur toute une ligne
    With Range(Cells(i + 1, 2), Cells(i + 1, 23)).Interior
        .ColorIndex = 0
        .Pattern = xlGray8
    End With
 
'défini les plages de cellules pour les différentes zones du tableau
'défini les traits verticaux gras
Set ligne1 = Range(Cells(i, 3), Cells(i + 2, 3))
Set ligne2 = Range(Cells(i, 7), Cells(i + 2, 7))
'défini les traits verticaux très gras
Set grosseligne1 = Range(Cells(i, 15), Cells(i + 2, 15))
Set grosseligne2 = Range(Cells(i, 17), Cells(i + 2, 17))
Set grosseligne3 = Range(Cells(i, 24), Cells(i + 2, 24))
'défini les doubles traits verticaux
Set doubleligne1 = Range(Cells(i, 5), Cells(i + 2, 5))
Set doubleligne2 = Range(Cells(i, 9), Cells(i + 2, 9))
Set doubleligne3 = Range(Cells(i, 11), Cells(i + 2, 11))
Set doubleligne4 = Range(Cells(i, 13), Cells(i + 2, 13))
Set doubleligne5 = Range(Cells(i, 16), Cells(i + 2, 16))
Set doubleligne6 = Range(Cells(i, 19), Cells(i + 2, 19))
Set doubleligne7 = Range(Cells(i, 21), Cells(i + 2, 21))
Set doubleligne8 = Range(Cells(i, 23), Cells(i + 2, 23))
 
'défini les zones de couleur
Set envert = Range(Cells(i, 3), Cells(i + 2, 6))
Set enbleu = Range(Cells(i, 7), Cells(i + 2, 14))
Set enviolet = Range(Cells(i, 15), Cells(i + 2, 16))
Set engris = Range(Cells(i, 17), Cells(i + 2, 23))
Set enorange = Range(Cells(i, 18), Cells(i + 2, 18))
Set engrisfonce = Range(Cells(i + 1, 21), Cells(i + 2, 21))
 
'défini la mise en forme de ligne1 et ligne2
With Union(ligne1, ligne2)
    .Borders(xlEdgeLeft).Weight = xlMedium
End With
 
'défini la mise en forme de grosseligne1, grosseligne2, grosseligne3
With Union(grosseligne1, grosseligne2, grosseligne3)
    .Borders(xlEdgeLeft).Weight = xlThick
End With
 
'défini la mise en forme de doubleligne1, doubleligne2, doubleligne3, doubleligne4, doubleligne5, doubleligne8, doubleligne6, doubleligne7
With Union(doubleligne1, doubleligne2, doubleligne3, doubleligne4, doubleligne5, doubleligne8)
    .Borders(xlEdgeLeft).LineStyle = xlDouble
    .Borders(xlEdgeLeft).Weight = xlThick
End With
 
With Union(doubleligne6, doubleligne7)
    .Borders(xlEdgeLeft).LineStyle = xlDouble
    .Borders(xlEdgeLeft).Weight = xlThick
    .Borders(xlEdgeRight).LineStyle = xlDouble
    .Borders(xlEdgeRight).Weight = xlThick
End With
 
'défini la couleur de la zone envert en fonction de la couleur dans la cellule "C2"
With envert.Interior
    .ColorIndex = Cells(2, 3).Interior.ColorIndex
End With
 
'défini la couleur de la zone enbleu en fonction de la couleur dans la cellule "G2"
With enbleu.Interior
    .ColorIndex = Cells(2, 7).Interior.ColorIndex
End With
 
'défini la couleur de la zone envert en fonction de la couleur dans la cellule "O2"
With enviolet.Interior
    .ColorIndex = Cells(2, 15).Interior.ColorIndex
End With
 
'défini la couleur de la zone engris en fonction de la couleur dans la cellule "Q2"
With engris.Interior
    .ColorIndex = Cells(2, 17).Interior.ColorIndex
End With
 
'défini la couleur de la zone enorange
With enorange.Interior
    .ColorIndex = 40
    .Pattern = xlSolid
End With
 
'défini la couleur de la zone engrisfonce
With engrisfonce.Interior
    .ColorIndex = 16
    .Pattern = xlSolid
End With
 
'pour boucler 1 ligne sur 3
i = i + 2
Next i
 
End Sub

Cette ligne apparait au dessus de 01-août-09 lorsque la macro est executée au moins deux fois, cad, lorsque l'on execute la macro une fois, niquel ça marche bien, mais lorsque l'on réactive, la petite ligne arrive.

Si quelqu'un prendre un peu de temps pour regarder mon code, pour voir d'ou vient mon erreur, je pense que sa situe au niveau de mon incrementation mais j'ai essayé plusieurs combinaisons et parfois le résultat est pire.

Merci à toutes et à tous

Bonne journée

**jfontaine** · 11/08/2009, 11h59

Bonjour,

Ajoute cette ligne juste après la déclaration de tes variables.
Tu repartiras avec un onglet vide de tableau et plus de problème

Code :

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

Rows("5:97").Delete

**mercatog** · 11/08/2009, 12h14

Un petit bricole pour récupérer le nombre de jours du mois ma

Code :

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

1
2
3
4
5
6
7
8
9
10
11
Public Function nbjmois(ByVal ma As Date) As Integer
Dim ms As Date
 
If Month(ma) = 12 Then
    nbjmois = 31
Else
    ms = CDate("01/" & Month(ma) + 1 & "/" & Year(ma)) 'la date du premier jour du mois suivant
    nbjmois = Day(DateAdd("D", -1, ms))    'retarncher 1 jour et récuuperer le jour
End If
 
End Function

à mettre dans un module
Edit, décembre corrigé

en bas, je ferai cela

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
 
'pour connaitre la derniere ligne utilisée dans la colonne A
DerniereLigne = Range("B65536").End(xlUp).Row
 
'efface toute la plage de cellule nécessaire à la construction du tableau, utile lors du passage d'un mois à l'autre pour effacer la dernière ligne
Range("A5:A" & DerniereLigne).EntireRow.Delete  'SI TU N AS AUCUNE DONNEE EN DESSOUS DE TON TABLEAU
 
'met la colonne A au format 01-août-09
Columns("A:A").NumberFormat = "[$-40C]dd-mmm-yy;@"
 
dteDate = CDate("01/" & Month(Date) & "/" & Year(Date)) 'variable qui contient la date actuelle et commence au premier jour du mois
 
'cette boucle permet d'afficher la date dans la 1ere colonne et d'incrémenter le jour du mois jusqu'à la fin du mois
 
    For i = 0 To nbjmois(Date) - 1
 
        Cells(6 + 3 * i, 1).Value = DateAdd("D", i, dteDate)
 
    Next i

s'il y a une seule instruction évite cela

Code :

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

1
2
3
4
 
With XXX
  .machin=truc
End With

il suffit:

Code :

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

XXX.machin=truc

et aussi, il est préférable d'ajouter au début du code

Code :

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

Application.ScreenUpdating = False

et à la fin

Code :

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

Application.ScreenUpdating = True

je propose alors cela (certes il y a d'autres trucs à optimiser)! mais bon!

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
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
Sub construction_tableau()
 
Dim dteDate As Date
Dim i As Integer
 
Application.ScreenUpdating = False
 
'pour connaitre la derniere ligne utilisée dans la colonne B (M, S, N)!!
DerniereLigne = Range("B65536").End(xlUp).Row
 
'efface toute la plage de cellule nécessaire à la construction du tableau, utile lors du passage d'un mois à l'autre pour effacer la dernière ligne
Range("A5:A" & DerniereLigne).EntireRow.Delete  'SI TU N AS AUCUNE DONNEE EN DESSOUS DE TON TABLEAU
 
'met la colonne A au format 01-août-09
Columns("A:A").NumberFormat = "[$-40C]dd-mmm-yy;@"
 
 
dteDate = CDate("01/" & Month(Date) & "/" & Year(Date))   'variable qui contient la date actuelle et commence au premier jour du mois
 
'cette boucle permet d'afficher la date dans la 1ere colonne et d'incrémenter le jour du mois jusqu'à la fin du mois
    For i = 0 To nbjmois(Date) - 1
 
        Cells(6 + 3 * i, 1).Value = DateAdd("D", i, dteDate)
 
    Next i
 
'cette boucle permet la construction de la mise en forme du tableau
 
For i = 0 To nbjmois(Date) - 1
 
    'pour signaler le quart
    Cells(6 + 3 * i, 2).Value = "M"
    Cells(7 + 3 * i, 2).Value = "S"
    Cells(8 + 3 * i, 2).Value = "N"
 
    'quadrille et centre les données
    With Range(Cells(6 + 3 * i, 2), Cells(8 + 3 * i, 23))
    .HorizontalAlignment = xlCenter
    .Borders(xlEdgeLeft).Weight = xlThin
    .Borders(xlEdgeRight).Weight = xlThin
    .Borders(xlEdgeTop).Weight = xlThin
    .Borders(xlEdgeBottom).Weight = xlThin
    .Borders(xlInsideVertical).Weight = xlThin
    .Borders(xlInsideHorizontal).Weight = xlThin
    End With
 
    'encadre toute la zone assignée à une date avec des traits gras
    With Range(Cells(6 + 3 * i, 1), Cells(8 + 3 * i, 23))
    .Borders(xlEdgeLeft).Weight = xlMedium
    .Borders(xlEdgeRight).Weight = xlMedium
    .Borders(xlEdgeTop).Weight = xlMedium
    .Borders(xlEdgeBottom).Weight = xlMedium
    End With
 
    'ajoute des pointillés sur toute une ligne
    With Range(Cells(7 + 3 * i, 2), Cells(7 + 3 * i, 23)).Interior
    .ColorIndex = 0
    .Pattern = xlGray8
    End With
 
    'défini les plages de cellules pour les différentes zones du tableau
 
    'défini les traits verticaux très gras
    Set grosseligne1 = Range(Cells(6 + 3 * i, 15), Cells(8 + 3 * i, 15))
    Set grosseligne2 = Range(Cells(6 + 3 * i, 17), Cells(8 + 3 * i, 17))
    Set grosseligne3 = Range(Cells(6 + 3 * i, 24), Cells(8 + 3 * i, 24))
 
    'défini les doubles traits verticaux
    Set doubleligne1 = Range(Cells(6 + 3 * i, 5), Cells(8 + 3 * i, 5))
    Set doubleligne2 = Range(Cells(6 + 3 * i, 9), Cells(8 + 3 * i, 9))
    Set doubleligne3 = Range(Cells(6 + 3 * i, 11), Cells(8 + 3 * i, 11))
    Set doubleligne4 = Range(Cells(6 + 3 * i, 13), Cells(8 + 3 * i, 13))
    Set doubleligne5 = Range(Cells(6 + 3 * i, 16), Cells(8 + 3 * i, 16))
    Set doubleligne6 = Range(Cells(6 + 3 * i, 19), Cells(8 + 3 * i, 19))
    Set doubleligne7 = Range(Cells(6 + 3 * i, 21), Cells(8 + 3 * i, 21))
    Set doubleligne8 = Range(Cells(6 + 3 * i, 23), Cells(8 + 3 * i, 23))
 
    'défini les traits verticaux gras
    With Range(Cells(6 + 3 * i, 3), Cells(8 + 3 * i, 7)) 'Union(ligne1, ligne2)
        .Borders(xlEdgeLeft).Weight = xlMedium
        .Borders(xlEdgeRight).Weight = xlMedium
    End With
 
    'défini la mise en forme de grosseligne1, grosseligne2, grosseligne3
    Union(grosseligne1, grosseligne2, grosseligne3).Borders(xlEdgeLeft).Weight = xlThick
 
    'défini la mise en forme de doubleligne1, doubleligne2, doubleligne3, doubleligne4, doubleligne5, doubleligne8, doubleligne6, doubleligne7
    With Union(doubleligne1, doubleligne2, doubleligne3, doubleligne4, doubleligne5, doubleligne8)
        .Borders(xlEdgeLeft).LineStyle = xlDouble
        .Borders(xlEdgeLeft).Weight = xlThick
    End With
 
    With Union(doubleligne6, doubleligne7)
        .Borders(xlEdgeLeft).LineStyle = xlDouble
        .Borders(xlEdgeLeft).Weight = xlThick
        .Borders(xlEdgeRight).LineStyle = xlDouble
        .Borders(xlEdgeRight).Weight = xlThick
    End With
 
Next i
 
'défini la couleur de la zone envert en fonction de la couleur dans la cellule "C2"
Range(Cells(6, 3), Cells(5 + 3 * nbjmois(Date), 6)).Interior.ColorIndex = 4 'Cells(2, 3).Interior.ColorIndex
 
'défini la couleur de la zone enbleu en fonction de la couleur dans la cellule "G2"
Range(Cells(6, 7), Cells(5 + 3 * nbjmois(Date), 14)).Interior.ColorIndex = 8
 
'défini la couleur de la zone envert en fonction de la couleur dans la cellule "O2"
Range(Cells(6, 15), Cells(5 + 3 * nbjmois(Date), 16)).Interior.ColorIndex = 7
 
 
'défini la couleur de la zone engris en fonction de la couleur dans la cellule "Q2"
Range(Cells(6, 17), Cells(5 + 3 * nbjmois(Date), 23)).Interior.ColorIndex = 15
 
 
'défini la couleur de la zone enorange
With Range(Cells(6, 18), Cells(5 + 3 * nbjmois(Date), 18)).Interior
    .ColorIndex = 45
    .Pattern = xlSolid
End With
 
'défini la couleur de la zone engrisfonce
With Range(Cells(6, 21), Cells(5 + 3 * nbjmois(Date), 21)).Interior
    .ColorIndex = 48
    .Pattern = xlSolid
End With
 
 
Application.ScreenUpdating = True
End Sub

J'apprends aussi

**jfontaine** · 11/08/2009, 13h52

Je vois bien les réponses de mercatog, mais ou sont les questions??

**mercatog** · 11/08/2009, 13h58

Désolé jfontaine, mais j'écris que j'apprends aussi.
et je partage ce que je viens d'apprendre
désolé donc
je m'eclipse

**altra** · 11/08/2009, 14h29

Re,

Merci Mercatog je me suis bien servi de ton code et la petite ligne ne revient plus, donc probleme résolu.

@jfontaine : en fait je n'avais pas réellement de question simplement une ligne qui m'embêtait.
J'avais déjà mis dans mon code

Code :

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

Range(Cells(5, 1), Cells(96, 23)).EntireRow.Delete

qui est je pense une version plus longue de

Code :

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

Rows("5:97").Delete

donc merci pour ça je saurais mieux l'écrire dorénavant.

Bonne journée à tous

Ah si question concernant le code de Mercatog pour trouver le nombre de jour dans un mois.

Est ce qu'il gère bien les années bisextiles?

En fait je ne le comprend pas bien, comment est ce que je peux faire pour simuler un autre mois que le mois actuel, sachant que je ne peux pas changer mon l'horloge de windows pour cause d'accés.

Merci

**mercatog** · 11/08/2009, 14h58

le 1er mars - 1journée donne le dernier jour de février

pour simuler, dans ta feuille écris en B1 : la formule =nbjmois(A1) où tu mets dans A1 n'importe quelle date pour simulation
la fonction bien sûr doit être écrite dans un module du classeur
cordialement

**altra** · 11/08/2009, 15h07

ok merci pour tout

Problème ligne lors de construction tableau [XL-2003]

Macros et VBA Excel

Discussions similaires

Partager

Partager