Discussion :

[adaoluz]

Bonjour les amis!

J'ai une feuille de calcul que j'utilise, mais elle génère des erreurs d'exécution

bien lorsque vous ouvrez la feuille de calcul, affiche le formulaire afin que les informations sont entrées,

mais lorsque je n'entre pas les informations, la date normale du formulaire.

Mais lorsque j'entre dans l'éditeur VBA et que j'essaie d'ouvrir le formulaire par l'éditeur, le "

Erreur d'exécution 6, 'Overflow'.

Voici le code détaillé qui peut m'aider, je vous en suis reconnaissant.


Note:

L'erreur est surlignée en rouge.

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
Option Explicit
 
Public Const LDlig As Byte = 12
Public Const Largeur_utile = 750
Public Const Left0 = 174
 
Public dt0 As Date
Public OldDdj As Date   ' date avant changement de ddj
Public Page As Byte     ' page 1jour/2semaine/3mois
Public nbj_trim As Byte ' nb de jours du trimestre
 
Public LDcol As Byte
Public CollLD As Object
 
Public T_ident As Variant   ' tableau des identités
Public TAct As Variant      ' tableau liste des activités
Public TInd As Variant      ' tableau liste des indisponibilités
Public TG As Variant        ' Tableau des événements pour graphique
 
Public Mte As Boolean
Public HistoColl As New Collection
 
 
Sub Ouvre_Accueil()
    dt0 = Date
    Page = 1
    UsfListOpen = False
    TAct = Sql.Get_ComboXL("Activités", "Config")
    TInd = Sql.Get_ComboXL("Indisponibilités", "Config")
    Usf_Accueil.Show
End Sub

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
 ' ***** MENU *************************************************************************************
Sub menu_select(Menu As String)
    Select Case Menu
        Case "Menu1a": Usf_Accueil.Hide
        Case "Menu1b": ActiveWorkbook.Save
        Case "Menu1c": Unload Usf_Accueil
        Case "Menu2a": List_Rsc (True)
        Case "Menu2b": New_Fiche_Rsc (True)
        Case "Menu2c": Usf_Bilan.Show
        Case "Menu3a": List_Rsc (False)
        Case "Menu3b": New_Fiche_Rsc (False)
        Case "Menu4a": Usf_EvnmtList.Show
        Case "Menu4b": New_Fiche_Evenmt
    End Select
End Sub

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
' ***** GRILLE ************************************************************************************
Sub Raz_grille(Optional x As Byte)
Dim ctrl As Control
 
    With Usf_Accueil
        For Each ctrl In .Controls
            If Left(ctrl.Name, 3) = "lbl" Or Left(ctrl.Name, 3) = "Ent" Then
                .Controls.Remove ctrl.Name
            End If
        Next ctrl
        .ScrollBar2.Visible = False
    End With
End Sub

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
Sub Dessine_grille(idx As Byte)
Dim i As Integer, j As Integer, Top0 As Integer
Dim Lbl As Control
Dim dt_lundi As Long, j0 As Integer, JS As Variant
Dim troismois(3) As Date, nbj_mois(3) As Byte, W(2) As Integer
Dim cell As Object, Coll As New Collection
 
    JS = Array("L", "M", "M", "J", "V", "S", "D")
    Raz_grille
    With Usf_Accueil
        Select Case idx
            Case 21
                LDcol = 24
                '.ScrollBar2.Visible = True
            Case 22
                LDcol = 7
                dt_lundi = LundiDu(CDate(.ddj.Caption))
            Case 23
                LDcol = Nb_Jours_Mois(CDate(.ddj.Caption))
                j0 = Weekday(DateSerial(Year(CDate(.ddj.Caption)), Month(CDate(.ddj.Caption)), 1), vbMonday)
            Case 90
                LDcol = 3
                For i = 0 To 3
                    troismois(i) = DateSerial(Year(CDate(.ddj.Caption)), i + Month(CDate(.ddj.Caption)), 1)
                    If i > 0 Then
                        nbj_mois(i - 1) = DateDiff("d", troismois(i - 1), troismois(i))
                        'Debug.Print Format(troismois(i - 1), "mmmm") & nbj_mois(i - 1)
                    End If
                Next i
                nbj_trim = nbj_mois(0) + nbj_mois(1) + nbj_mois(2)
        End Select
 
        Top0 = .Label18.Top + 18
 
        Set CollLD = New Collection
        For i = 0 To LDcol - 1
            Set Lbl = .Controls.Add("Forms.label.1")
            With Lbl
                .SpecialEffect = 0
                .BorderStyle = 1
                .BorderColor = &H8000000A
                .BackColor = &HFFFFFF
                .Top = Top0
                .Height = 22
                If idx = 90 Then    ' trimestre
                    W(i) = Int(nbj_mois(i) / nbj_trim * Largeur_utile) + 0.1
                    .Width = W(i)
                    .Left = 174
                    If i = 1 Then .Left = .Left + W(0)
                    If i = 2 Then .Left = .Left + W(0) + W(1)
                Else
                    .Width = Int(Largeur_utile / LDcol) + 0.1
                    .Left = 174 + (i * .Width)
                End If
                .Name = "Ent" & i
                Select Case idx
                    Case 21
                        .Caption = Format(i / 24, "hh:mm")
                        .Font.Size = 7
                    Case 22
                        .Caption = Format(dt_lundi + i, "ddd dd/mm/yy")
                        .TextAlign = 2
                    Case 23
                        .Caption = JS((j0 + i) - ((Int(((j0 + i) - 1) / 7)) * 7) - 1) & vbCrLf & i + 1
                        .TextAlign = 2
                    Case 90
                        .Caption = Format(troismois(i), "mmmm")
                        .TextAlign = 2
                End Select
            End With
 
            For j = 0 To LDlig - 1
                Set Lbl = .Controls.Add("Forms.label.1")
                With Lbl
                    .SpecialEffect = 0
                    .BorderStyle = 1
                    .BorderColor = &H8000000A
                    .BackColor = &HFFFFFF
                    .Top = Top0 + 22 + (j * 24)
                    .Height = 24
                    If idx = 90 Then    ' trimestre
                        .Width = W(i)
                        .Left = 174
                        If i = 1 Then .Left = .Left + W(0)
                        If i = 2 Then .Left = .Left + W(0) + W(1)
                    Else
                        .Width = Int(Largeur_utile / LDcol) + 0.1
                        .Left = 174 + (i * .Width)
                    End If
                    .Name = "lbl" & i + (j * LDcol)
                End With
                Set cell = New Class_ListData
                Set cell.LDcell = Lbl
                CollLD.Add cell
            Next j
        Next i
 
        .ScrollBar1.Left = Lbl.Left + Lbl.Width
        .Label18.Width = Lbl.Left + Lbl.Width - .Label18.Left
        .ScrollBar2.Width = Lbl.Width * LDcol
    End With
 
    Jour_encours
 
End Sub

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
Sub Jour_encours(Optional x As Byte)
Dim i As Byte, dt1 As Date, dt2 As Date, nbjtrim As Byte

    With Usf_Accueil
        For i = 0 To LDcol - 1
            .Controls("Ent" & i).BackColor = &HFFFFFF
        Next i
        
        Select Case LDcol
            Case 24         ' jour
            
            Case 7          ' semaine
                For i = 0 To 6
                    If CDate(Right(.Controls("Ent" & i).Caption, 8)) = Date Then
                        .Controls("Ent" & i).BackColor = &HC0FFC0
                    End If
                Next i
            
            Case 28 To 31   ' mois
                .Controls("Ent" & Day(Date) - 1).BackColor = &HC0FFC0
                
            Case 3          ' trimestre
                dt1 = DateSerial(Year(CDate(.ddj.Caption)), Month(CDate(.ddj.Caption)), 1)
                dt2 = DateAdd("m", 3, dt1)
                If Date >= dt1 And Date < dt2 Then
                    nbjtrim = DateDiff("d", dt1, dt2)
                    With .Label37
                        .Visible = True
                        .ZOrder msoBringToFront
                        .Width = Largeur_utile / nbjtrim
                        .Left = 174 + (.Width * (DateDiff("d", dt1, Date)))
                        .Caption = Day(Date)
                    End With
                Else
                    .Label37.Visible = False
                End If
            
        End Select

    End With
End Sub

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
Sub Dessine_Event(Optional x As Byte)
Dim date1 As Date, date2 As Date, TY As String, Act As String
Dim Histolbl As Object, ctrl As Variant, Lbl As Object
Dim i As Integer, j As Byte, lig As Byte, lg As Byte
Dim Dtdeb As Long, Dtfin As Long, hrdeb As Single, hrfin As Single, W As Single, W0 As Single
Dim bc As Long, Rouge As Integer, Vert As Integer, Bleu As Integer
 
    With Usf_Accueil
        For Each ctrl In .Controls
            If Left(ctrl.Name, 5) = "Histo" Then .Controls.Remove ctrl.Name
        Next
        Select Case Page
            Case 1
                date1 = CDate(.ddj.Caption)
                date2 = date1
            Case 2
                date1 = LundiDu(CDate(.ddj.Caption))
                date2 = DateAdd("d", 6, date1)
            Case 3
                date1 = DateSerial(Year(CDate(.ddj.Caption)), Month(CDate(.ddj.Caption)), 1)
                date2 = DateAdd("d", LDcol - 1, date1)
            Case 16
                date1 = DateSerial(Year(CDate(.ddj.Caption)), Month(CDate(.ddj.Caption)), 1)
                date2 = DateAdd("d", nbj_trim, date1)
        End Select
 
        Select Case .ComboBox5.ListIndex
            Case 0: TY = ""
            Case 1: TY = "A"
            Case 2: TY = "I"
        End Select
 
        Act = IIf(.ComboBox6.ListIndex = 0, "", .ComboBox6.Value)
 
        TG = Sql.Get_Graphique(date1, date2, TY, Act)
        If UBound(TG, 1) > 0 Then
            For i = 2 To UBound(TG, 1)
                lig = 0
                For j = 1 To LDlig
                    If CStr(TG(i, 7)) = .Controls("Txt" & j + 36).Caption Then lig = j
                Next j
                If lig > 0 Then
'"SELECT E.Id, E.Deb, E.Fin, E.Hdeb, E.Hfin, E.Titre, R.Id, E.Genre, E.Categ, E.Img
                    If CDate(TG(i, 2)) < date1 Then
                        Dtdeb = date1
                        hrdeb = 0
                    Else
                        Dtdeb = CLng(CDate(TG(i, 2)))
                        hrdeb = CSng(CDate(TG(i, 4)))
                    End If
 
                    If CDate(TG(i, 3)) > date2 Then
                        Dtfin = date2
                        hrfin = 0
                    Else
                        Dtfin = CLng(CDate(TG(i, 3)))
                        hrfin = CSng(CDate(TG(i, 5)))
                    End If
 
                    Set Lbl = .Controls.Add("Forms.Label.1", "Histo" & TG(i, 1))
                    Lbl.Top = .Controls("Txt" & lig).Top + 1
                    Lbl.Height = .Controls("Txt" & lig).Height - 2
                    If Page = 16 Then
                        W = Int(Largeur_utile / nbj_trim) + 0.1
                    Else
                        W = Int(Largeur_utile / LDcol) + 0.1
                    End If
 
                    If Exist_Fichier(CStr(TG(i, 10))) Then
                        Lbl.Picture = LoadPicture(CStr(TG(i, 10)))
                        Lbl.PicturePosition = 1
                    End If
 
                    Select Case Page
                        Case 1
                            Lbl.Left = Left0 + 2 + IIf(CLng(date1) <= Dtdeb, (W * hrdeb * 24), 0)
                            W0 = Largeur_utile - Lbl.Left + Left0 - 5
                            If CLng(date2) < Dtfin Then
                                Lbl.Width = W0
                            Else
                                If Dtdeb = Dtfin Then
                                    If hrfin = 0 Then
                                        Lbl.Width = IIf(hrdeb = 0, Largeur_utile - 7, W0)
                                    Else
                                        If hrfin > hrdeb Then Lbl.Width = (W * hrfin * 24) - (W * hrdeb * 24)
                                    End If
                                Else
                                    Lbl.Width = IIf(hrfin = 0, W0, W * hrfin * 24)
                                End If
                            End If
 
                        Case 2
                            Lbl.Left = Left0 + 2 + (W * (Dtdeb - CLng(date1))) + (W * hrdeb)
                            Lbl.Width = (W * (1 + Dtfin - Dtdeb)) - 2
                            If (hrfin <> hrdeb) And Not (hrfin = 0 And hrdeb = 0) Then
                                Lbl.Width = Lbl.Width - (W * (1 - Abs(hrfin - hrdeb)))
                            End If
 
                        Case 3, 16
                            Lbl.Left = Left0 + 2 + (W * (Dtdeb - CLng(date1)))
                            Lbl.Width = (W * (1 + Dtfin - Dtdeb)) - 2
 
                    End Select
 
                    If Not TG(i, 9) = "" Then
                        On Error Resume Next
                        With Sheets("Config")
                            If Left(TG(i, 8), 1) = "A" Then
                                bc = .Cells(2, "H").Interior.Color
                                lg = Application.Match(TG(i, 9), .Columns("I"), 0)
                                bc = .Cells(lg, "H").Interior.Color
                            Else
                                bc = .Cells(2, "J").Interior.Color
                                lg = Application.Match(TG(i, 9), .Columns("K"), 0)
                                bc = .Cells(lg, "J").Interior.Color
                            End If
                        End With
                        On Error GoTo 0
                    End If
 
                    If Right(TG(i, 8), 1) = "P" Then
                        Lbl.Top = Lbl.Top - 12
                        Lbl.Left = Lbl.Left - 5
                        Lbl.Width = 30
                        Lbl.Height = 30
                        Lbl.Picture = Usf_Accueil.Flag.Picture
 
                        Lbl.BorderStyle = 0
                        Lbl.BackStyle = 0
                        Lbl.SpecialEffect = 0
                    Else
                        Rouge = Int(bc Mod 256)
                        Vert = Int((bc Mod 65536) / 256)
                        Bleu = Int(bc / 65536)
                        Lbl.BackColor = RGB(Rouge, Vert, Bleu)
 
                        Lbl.TextAlign = 2
                        Lbl.SpecialEffect = 1
                        Lbl.Caption = TG(i, 9) & vbCrLf & TG(i, 6)
                    End If
 
                    Set Histolbl = New Class_ListData
                    Set Histolbl.Histo = Lbl
                    HistoColl.Add Histolbl
 
                End If
            Next i
        End If
    End With
End Sub

[Invité]

Bonjour,

On ne voit pas comment LDCOL prend une valeur > 0. Servez vous de Debug.Print et de la fenêtre exécution (Ctrl-G) pour vérifier la valeur de vos variables en cours de programme.

[adaoluz]

Je pense que l'erreur est vraiment la valeur des variables, pourriez-vous me dire comment je peux procéder?

[adaoluz]

Bonjour, j'ai vérifié la valeur des variables

tout commence par zéro lorsque l'erreur se produit.

[Invité]

Bonjour, j'ai vérifié la valeur des variables

tout commence par zéro lorsque l'erreur se produit.

Une variable byte ne peut être égale à -1, c'est pourtant ce que vous faites dans cette ligne de code si LDCOL = 0

Code :

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

For i = 0 To LDcol - 1

[adaoluz]

Que puis-je faire pour éviter ce débordement?