Modification tableau sortie velo

**Seuche** · 01/04/2012, 10h20

bonjour le forum
je reviens vers vous pour savoir:
1) si il est possible dans mon USF onglet Statistique ANNUEL d'avoir
la date dans le Label 33 du jour de ma sortie Mini & avoir aussi la date dans mon Label 34 sachant que dans les Label 29 & 30 il y a les Kms Mini ET Maxi

2)avoir la date de ma vitesse Mini dans Le label 37 & la Vitesse dans le Label 39
avoir la date de ma vitesse Maxi dans Le label 39 & la Vitesse dans le Label 40

3) avoir aussi la même chose avec le temps de parcours mini et maxi

merci de voir ce que vous pouvez faire

PS: car je pense que je vais être obliger de supprimer l'onglet graphique car le graphique et trop petit

**Daniel.C** · 01/04/2012, 12h09

Bonjour,

Remplace la macro

Code :

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

Private Sub UserForm_Initialize()

par celle-ci :

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
Private Sub UserForm_Initialize()
    Dim tablo() As String
    Dim Temps As Long
    Dim Sh As Worksheet
    Dim ResMin As Double
    Dim ResMax As Double
    Dim ResVitMin As Double
    Dim ResVitMax As Double
    DTPicker1.Value = Date
    TextBox5 = Format(calcul("B", 1), "# ##0.000")
    TextBox10 = Format(calcul("D", 1), "00")
    TextBox9 = Format(calcul("C", 1), "00")
    TextBox14 = Format(calcul("E", 1), "00")
    TextBox16 = Format(calcul("F", 1), "00")
    TextBox6 = Format(Val(TextBox9) + Val(TextBox10) + Val(TextBox14) + Val(TextBox16), "00")
    TextBox7 = calcul("G", 2)
 
    TextBox13.Value = (Sheets("Paramètre").[G1] / 12) - Sheets("Paramètre").Cells(ActiveSheet.[Z1] + 2, 2).Value
 
    TextBox13.Value = Format(Int(TextBox13.Value * 1000) / 1000, "0.000")
    If TextBox13.Value < 0 Then
        Label22.Caption = "Objectif ATTEIND :"
        Label22.ForeColor = RGB(0, 255, 0)
        Label24.Caption = "Objectif Dépassé De"
        Label24.ForeColor = RGB(0, 255, 0)
        TextBox13.Value = Format(TextBox13.Value * -1, "0.000")
        TextBox13.ForeColor = RGB(0, 255, 0)
    End If
    Label20.Caption = CStr(Sheets("Paramètre").[G1]) & ""
    Label21.Caption = CStr(Int(Sheets("Paramètre").[G1] / 12)) & ""
    Label29.Caption = Format(Sheets("Paramètre").[H1], "# ##0.000")
    Label30.Caption = Format(Sheets("Paramètre").[I1], "# ##0.000")
 
    tablo = Split(TextBox7, ":")
    If UBound(tablo) = -1 Then Exit Sub
    Temps = (CLng(tablo(LBound(tablo))) * 60) + CLng((tablo(LBound(tablo) + 1)))    'temps en minutes
    TextBox8 = Format(Sheets("Paramètre").[N1], "# ##0.000")
    TextBox11 = Format(calcul("J", 1), "# ##0.000")
    TextBox12 = Format(calcul("K", 1), "# ##0.000")
    TextBox15 = Format(calcul("L", 1), "# ##0.000")
    TextBox17 = Format(calcul("M", 1), "# ##0.000")
 
    TextBox1.SetFocus
    ' Se positionner sur la page 1
    Me.MultiPage1.Value = 0
    ResMin = 9 ^ 9
    ResMax = 0
    ResVitMin = 9 ^ 9
    ResVitMax = 0
    With Application
        For Each Sh In Worksheets
            If Sh.Name <> "Paramètre" And Sh.Name <> "Graphique" Then
                'Date mini
                If .Small(Sh.[B:B], 2) < ResMin And .Small(Sh.[B:B], 2) > 0 Then
                    ResMin = .Small(Sh.[B:B], 2)
                    Me.Label33 = .Index(Sh.[A:A], .Match(.Small(Sh.[B:B], 2), Sh.[B:B], 0), 1)
                End If
                'Date maxi
                If .Max(Sh.[B:B]) > ResMax And .Max(Sh.[B:B]) > 0 Then
                    ResMax = .Max(Sh.[B:B])
                    Me.Label34 = .Index(Sh.[A:A], .Match(.Max(Sh.[B:B]), Sh.[B:B], 0), 1)
                End If
                'Vitesse mini
                Var = .Small(Sh.[D:D], 2)
                If .Small(Sh.[D:D], 2) < ResVitMin And .Small(Sh.[D:D], 2) > 0 Then
                    ResVitMin = .Small(Sh.[D:D], 2)
                    Me.Label37 = .Index(Sh.[A:A], .Match(.Small(Sh.[D:D], 2), Sh.[D:D], 0), 1)
                End If
                'Vitesse maxi
                If .Max(Sh.[D:D]) > ResVitMax And .Max(Sh.[D:D]) > 0 Then
                    ResVitMax = .Max(Sh.[D:D])
                    Me.Label38 = .Index(Sh.[A:A], .Match(.Max(Sh.[D:D]), Sh.[D:D], 0), 1)
                End If
            End If
        Next Sh
        Me.Label39.Caption = Format(ResVitMin, "# ##0.000")
        Me.Label40.Caption = Format(ResVitMax, "# ##0.000")
    End With
End Sub

Note que le Label30 n'est pas renseigné. Les modifs sont en fin de macro.

**Seuche** · 01/04/2012, 13h12

bonjour
j'avais oublier dans mon tableau de mettre le temps de parcours mini et maxi
est ce qu'il serait possible que tu me rajoute les codes

a part pour le Label30 je comprend pas pourquoi sa ne fonctionne pas

Amicalement
j'ai remis un fichier avec la modification

**Daniel.C** · 01/04/2012, 14h33

Je ne comprends pas ta formule en I1 de la feuille Paramètre. A ta place, je mettrais :

Code :

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

=MAX(I3:I14)

Je n'en ai pas tenu compte. Comme tu n'avais pas modifié le code dans le second classeur, j'ai continué à travailler sur le premier.
Remplace la macro

Code :

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

Private Sub UserForm_Initialize()

:

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
Private Sub UserForm_Initialize()
    Dim tablo() As String
    Dim Temps As Long
    Dim Sh As Worksheet
    Dim ResMin As Double
    Dim ResMax As Double
    Dim ResVitMin As Double
    Dim ResVitMax As Double
    DTPicker1.Value = Date
    TextBox5 = Format(calcul("B", 1), "# ##0.000")
    TextBox10 = Format(calcul("D", 1), "00")
    TextBox9 = Format(calcul("C", 1), "00")
    TextBox14 = Format(calcul("E", 1), "00")
    TextBox16 = Format(calcul("F", 1), "00")
    TextBox6 = Format(Val(TextBox9) + Val(TextBox10) + Val(TextBox14) + Val(TextBox16), "00")
    TextBox7 = calcul("G", 2)
 
    TextBox13.Value = (Sheets("Paramètre").[G1] / 12) - Sheets("Paramètre").Cells(ActiveSheet.[Z1] + 2, 2).Value
 
    TextBox13.Value = Format(Int(TextBox13.Value * 1000) / 1000, "0.000")
    If TextBox13.Value < 0 Then
        Label22.Caption = "Objectif ATTEIND :"
        Label22.ForeColor = RGB(0, 255, 0)
        Label24.Caption = "Objectif Dépassé De"
        Label24.ForeColor = RGB(0, 255, 0)
        TextBox13.Value = Format(TextBox13.Value * -1, "0.000")
        TextBox13.ForeColor = RGB(0, 255, 0)
    End If
    Label20.Caption = CStr(Sheets("Paramètre").[G1]) & ""
    Label21.Caption = CStr(Int(Sheets("Paramètre").[G1] / 12)) & ""
    Label29.Caption = Format(Sheets("Paramètre").[H1], "# ##0.000")
    Label30.Caption = Format(Sheets("Paramètre").[I1], "# ##0.000")
 
    tablo = Split(TextBox7, ":")
    If UBound(tablo) = -1 Then Exit Sub
    Temps = (CLng(tablo(LBound(tablo))) * 60) + CLng((tablo(LBound(tablo) + 1)))    'temps en minutes
    TextBox8 = Format(Sheets("Paramètre").[N1], "# ##0.000")
    TextBox11 = Format(calcul("J", 1), "# ##0.000")
    TextBox12 = Format(calcul("K", 1), "# ##0.000")
    TextBox15 = Format(calcul("L", 1), "# ##0.000")
    TextBox17 = Format(calcul("M", 1), "# ##0.000")
 
    TextBox1.SetFocus
    ' Se positionner sur la page 1
    Me.MultiPage1.Value = 0
    ResMin = 9 ^ 9
    ResMax = 0
    ResVitMin = 9 ^ 9
    ResVitMax = 0
    With Application
        For Each Sh In Worksheets
            If Sh.Name <> "Paramètre" And Sh.Name <> "Graphique" Then
                'Date mini
                If .Small(Sh.[B:B], 2) < ResMin And .Small(Sh.[B:B], 2) > 0 Then
                    ResMin = .Small(Sh.[B:B], 2)
                    Me.Label33 = .Index(Sh.[A:A], .Match(.Small(Sh.[B:B], 2), Sh.[B:B], 0), 1)
                End If
                'Date maxi
                If .Max(Sh.[B:B]) > ResMax And .Max(Sh.[B:B]) > 0 Then
                    ResMax = .Max(Sh.[B:B])
                    Me.Label34 = .Index(Sh.[A:A], .Match(.Max(Sh.[B:B]), Sh.[B:B], 0), 1)
                End If
                'Vitesse mini
                Var = .Small(Sh.[D:D], 2)
                If .Small(Sh.[D:D], 2) < ResVitMin And .Small(Sh.[D:D], 2) > 0 Then
                    ResVitMin = .Small(Sh.[D:D], 2)
                    Me.Label37 = .Index(Sh.[A:A], .Match(.Small(Sh.[D:D], 2), Sh.[D:D], 0), 1)
                End If
                'Vitesse maxi
                If .Max(Sh.[D:D]) > ResVitMax And .Max(Sh.[D:D]) > 0 Then
                    ResVitMax = .Max(Sh.[D:D])
                    Me.Label38 = .Index(Sh.[A:A], .Match(.Max(Sh.[D:D]), Sh.[D:D], 0), 1)
                End If
            End If
        Next Sh
        Me.Label30.Caption = Format(ResMax, "# ##0.000")
        Me.Label39.Caption = Format(ResVitMin, "# ##0.000")
        Me.Label40.Caption = Format(ResVitMax, "# ##0.000")
    End With
End Sub
 
    Dim tablo() As String
    Dim Temps As Long
    Dim Sh As Worksheet
    Dim ResMin As Double
    Dim ResMax As Double
    Dim ResVitMin As Double
    Dim ResVitMax As Double
    DTPicker1.Value = Date
    TextBox5 = Format(calcul("B", 1), "# ##0.000")
    TextBox10 = Format(calcul("D", 1), "00")
    TextBox9 = Format(calcul("C", 1), "00")
    TextBox14 = Format(calcul("E", 1), "00")
    TextBox16 = Format(calcul("F", 1), "00")
    TextBox6 = Format(Val(TextBox9) + Val(TextBox10) + Val(TextBox14) + Val(TextBox16), "00")
    TextBox7 = calcul("G", 2)
 
    TextBox13.Value = (Sheets("Paramètre").[G1] / 12) - Sheets("Paramètre").Cells(ActiveSheet.[Z1] + 2, 2).Value
 
    TextBox13.Value = Format(Int(TextBox13.Value * 1000) / 1000, "0.000")
    If TextBox13.Value < 0 Then
        Label22.Caption = "Objectif ATTEIND :"
        Label22.ForeColor = RGB(0, 255, 0)
        Label24.Caption = "Objectif Dépassé De"
        Label24.ForeColor = RGB(0, 255, 0)
        TextBox13.Value = Format(TextBox13.Value * -1, "0.000")
        TextBox13.ForeColor = RGB(0, 255, 0)
    End If
    Label20.Caption = CStr(Sheets("Paramètre").[G1]) & ""
    Label21.Caption = CStr(Int(Sheets("Paramètre").[G1] / 12)) & ""
    Label29.Caption = Format(Sheets("Paramètre").[H1], "# ##0.000")
    Label30.Caption = Format(Sheets("Paramètre").[I1], "# ##0.000")
 
    tablo = Split(TextBox7, ":")
    If UBound(tablo) = -1 Then Exit Sub
    Temps = (CLng(tablo(LBound(tablo))) * 60) + CLng((tablo(LBound(tablo) + 1)))    'temps en minutes
    TextBox8 = Format(Sheets("Paramètre").[N1], "# ##0.000")
    TextBox11 = Format(calcul("J", 1), "# ##0.000")
    TextBox12 = Format(calcul("K", 1), "# ##0.000")
    TextBox15 = Format(calcul("L", 1), "# ##0.000")
    TextBox17 = Format(calcul("M", 1), "# ##0.000")
 
    TextBox1.SetFocus
    ' Se positionner sur la page 1
    Me.MultiPage1.Value = 0
    ResMin = 9 ^ 9
    ResMax = 0
    ResVitMin = 9 ^ 9
    ResVitMax = 0
    With Application
        For Each Sh In Worksheets
            If Sh.Name <> "Paramètre" And Sh.Name <> "Graphique" Then
                'Date mini
                If .Small(Sh.[B:B], 2) < ResMin And .Small(Sh.[B:B], 2) > 0 Then
                    ResMin = .Small(Sh.[B:B], 2)
                    Me.Label33 = .Index(Sh.[A:A], .Match(.Small(Sh.[B:B], 2), Sh.[B:B], 0), 1)
                End If
                'Date maxi
                If .Max(Sh.[B:B]) > ResMax And .Max(Sh.[B:B]) > 0 Then
                    ResMax = .Max(Sh.[B:B])
                    Me.Label34 = .Index(Sh.[A:A], .Match(.Max(Sh.[B:B]), Sh.[B:B], 0), 1)
                End If
                'Vitesse mini
                Var = .Small(Sh.[D:D], 2)
                If .Small(Sh.[D:D], 2) < ResVitMin And .Small(Sh.[D:D], 2) > 0 Then
                    ResVitMin = .Small(Sh.[D:D], 2)
                    Me.Label37 = .Index(Sh.[A:A], .Match(.Small(Sh.[D:D], 2), Sh.[D:D], 0), 1)
                End If
                'Vitesse maxi
                If .Max(Sh.[D:D]) > ResVitMax And .Max(Sh.[D:D]) > 0 Then
                    ResVitMax = .Max(Sh.[D:D])
                    Me.Label38 = .Index(Sh.[A:A], .Match(.Max(Sh.[D:D]), Sh.[D:D], 0), 1)
                End If
            End If
        Next Sh
        Me.Label30.Caption = Format(ResMax, "# ##0.000")
        Me.Label39.Caption = Format(ResVitMin, "# ##0.000")
        Me.Label40.Caption = Format(ResVitMax, "# ##0.000")
    End With
End Sub