Userform (suite)

Range("E" & ndx).Select
With ActiveCell
.Value = Val(Str(txt_Temps.Text)) * 100
.NumberFormat = "##"" ' ""##"" '' """
End With

If xTemps < xAccordé Then
txt_Pénalités.Caption = 0
Exit Sub
End If

If xTemps < xLimite Then
delta = (xTemps - xAccordé) 'différence
P_Entier = Int(delta) 'partie entière
P_Décim = delta - P_Entier 'partie décimale

If P_Décim > 0 Then
xPénalités = P_Entier * 0.25 + 0.25
Else
xPénalités = P_Entier * 0.25
End If
txt_Pénalités.Caption = Format(xPénalités, "##0.00")
txt_Temps.Text = Format(xTemps, "##0.00")
Else
txt_Pénalités.Caption = "ELIMINE"
End If

Bonjour,

Claude Trouet que je remerci encore m'a permis d'avancer dans mon projet.
Cependant et malgré ses conseils (utilisation de l'enregistreur de macros)je
ne parviens pas à débugger la fin du programme. Je reprends donc
l'explication:

Toutes les cellules contenant des temps sont au format personnalise suivant:
##" ' "##" '' "

Les cellules contenant des éventuelles pénalités de temps (colonne F) sont
au format personnalisé suivant:[>=2]0,00" pts";0,00" pt"_s

Les cellules contenant les points du parcours (colonne G) et le total des
énalités éventuelles de temps et des points parcours (colonne H) sont au
format personnalisé suivant: [>=2]0,00" pts";[Rouge]0,00" pt"_s

Le temps accordé est en A6 et le temps limite en B6 au format personnalisé
suivant
##" ' "##" '' "

1) Au lieu d'afficher dans le userform uniquement le total des points obtenu
aux obstacles uniquement sans tenir compte des pénalités de temps j'aimerais
afficher ce dernier.
Total points = total points obtenus aux différents obstacles - refus -
éventuelles pénalités de temps
NB: Le total des points obtenu aux obstacles continuant de se reporter en
colonne G. Il s'agit uniquement de modifier (ou de rajouter) une case au
userform

2) Il y a une petite erreur dans le calcul des pénalités de temps. En effet
il y a une pénalités de temps pour toute seconde ou fraction de seconde
entamée.
ex: Si on a un temps accordé de 86'00'' et que le concurrent met 86'00''
pour effectuer son parcours il doit être pénalisé de 0,25 pt. S'il met
87'00'' il sera pénalisé de 0,50 pt

3)Il y a enfin une petite erreur dans l'affichage de la colonne D (le temps
mis par le concurrent pour effectuer son parcours) L'userform lorsque le
temps est strictement inférieur au temps accordé renoit le temps multiplié
par 100
ex au lieu de renvoyer 5829 (ce qui compte tenu du format personnalisé
affiche dans la cellule 58'29'') il renvoit 582900 (donc à l'affichage
5829'00'')

Merci
Voila mon code actuel mais si quelqu'un préfère je peux lui envoyer le
fichier (jé préférerais)

Private Sub CheckBox1_Change()
Calculer_Total
End Sub

Private Sub CheckBox2_Change()
Calculer_Total
End Sub

Private Sub CheckBox3_Change()
Calculer_Total
End Sub

Private Sub CheckBox4_Change()
Calculer_Total
End Sub

Private Sub CheckBox5_Change()
Calculer_Total
End Sub

Private Sub CheckBox6_Change()
Calculer_Total
End Sub

Private Sub CheckBox7_Change()
Calculer_Total
End Sub

Private Sub CheckBox8_Change()
Calculer_Total
End Sub

Private Sub CheckBox9_Change()
Calculer_Total
End Sub

Private Sub Calculer_Total()
Total = 0
'gestion des refus 9999 si + de 2 refus
If opt_Refus_1.Value = True Then Total = Total - 4
If opt_Refus_2.Value = True Then Total = Total - 8
If opt_Refus_3.Value = True Then
Total = 9999
txt_Points.Caption = "ELIMINE"
Exit Sub
End If

'Total si moins de 3 refus
If CheckBox1.Value = True Then Total = Total + 1
If CheckBox2.Value = True Then Total = Total + 2
If CheckBox3.Value = True Then Total = Total + 3
If CheckBox4.Value = True Then Total = Total + 4
If CheckBox5.Value = True Then Total = Total + 5
If CheckBox6.Value = True Then Total = Total + 6
If CheckBox7.Value = True Then Total = Total + 7
If CheckBox8.Value = True Then Total = Total + 8
If CheckBox9.Value = True Then Total = Total + 9

'OK, une des 3 option est sélectionnée
If OptionButton1.Value = True Then Total = Total + 20
If OptionButton2.Value = True Then Total = Total + 10
If OptionButton3.Value = True Then Total = Total - 20
'mettre à jour la case Total
txt_Points.Caption = Format(Total, "##0.00")
End Sub

Private Sub CommandButton1_Click()
Dim Total
Total = Val(txt_Points.Caption)
'contrôle qu'un participant est sélectionné
If lst_Participants.ListIndex = -1 Then
MsgBox "Sélectionner un participant !"
Exit Sub
End If

'calcul du Total
Calculer_Total

'calcule les pénalités ( cas clic direct sur bouton OK )
If Total <> 9999 Then Calculer_Pénalités

'gestion du temps mis
Select Case txt_Temps.Text
Case "AB"
Total = 9999
Case ""
If Total <> 9999 Then
MsgBox "Préciser le temps mis ou abandon !"
txt_Temps.SetFocus
Exit Sub
End If
Case Else
If txt_Pénalités.Caption = "ELIMINE" Then
Total = 9999
Else
Total = Total - Val(txt_Pénalités.Caption)
End If
End Select

If Total <> 9999 Then
'vérifie qu'une des 3 options est sélectionnée
If OptionButton1.Value = False _
And OptionButton2.Value = False _
And OptionButton3.Value = False Then
MsgBox "Vous n'avez pas renseigné le dernier obstacle!"
Exit Sub
End If
End If

'Résultat dans la cellule
'la ligne est celle correspondant à l'index dans la liste +10
ndx = lst_Participants.ListIndex + 10
Range("G" & ndx).Select
If Total <> 9999 Then
'total des points
ActiveCell.Value = Format(txt_Points.Caption, "##0")
'temps
Range("E" & ndx).Select
With ActiveCell
.Value = Val(Str(txt_Temps.Text)) * 100
.NumberFormat = "##"" ' ""##"" '' """
End With
'Pénalités
Range("F" & ndx).Select
With ActiveCell
.Value = Val(Str(txt_Pénalités.Caption))
.NumberFormat = "[>=2]0.00"" pts"";0.00"" pt""_s"
If ActiveCell.Value = 0 Then ActiveCell = ""
End With
'Colonne H somme des points - pénalités
MaSomme = Val(Str(txt_Points.Caption)) -
Val(Str(txt_Pénalités.Caption))
Range("H" & ndx).Select
With ActiveCell
.Value = MaSomme
.NumberFormat = "[>=2]0.00"" pts"";[Red]0.00"" pt""_s"
End With
Else
Range("G" & ndx).Select
If txt_Temps.Text = "AB" Then 'abandon
ActiveCell.Value = "AB"
Else
ActiveCell.Value = "EL"
End If
'vide les cellules en E, F et H
Range("E" & ndx).Value = ""
Range("F" & ndx).Value = ""
Range("H" & ndx).Value = ""
End If
End Sub

Private Sub CommandButton2_Click()
'première cellule vide de la colonne G à partir ligne 10
Sheets("Participants").Activate
Range("G10").Select
Do While ActiveCell.Value <> "" 'boucle tant que cellule est non
vide
ActiveCell.Offset(1, 0).Select 'ligne du dessous
Loop
Hide
End Sub

Private Sub lst_Participants_Change()
'renseigner le numéro, le cavalier et le cheval
If lst_Participants.ListIndex = -1 Then
'réinitialiser les checkbox, etc
lbl_Numéro.Caption = ""
lbl_Cavalier.Caption = ""
lbl_Cheval.Caption = ""
Else
Init_Obstacles
lbl_Numéro.Caption =
lst_Participants.List(lst_Participants.ListIndex, 0)
lbl_Cavalier.Caption =
lst_Participants.List(lst_Participants.ListIndex, 2)
lbl_Cheval.Caption =
lst_Participants.List(lst_Participants.ListIndex, 1)
End If
End Sub


Private Sub TextBox1_Change()
TextBox1 = MaSomme
End Sub


Private Sub opt_Refus_0_Click()
Calculer_Total
End Sub

Private Sub opt_Refus_1_Click()
Calculer_Total
End Sub

Private Sub opt_Refus_2_Click()
Calculer_Total
End Sub

Private Sub opt_Refus_3_Click()
Calculer_Total
End Sub

Private Sub OptionButton1_Click()
Calculer_Total
End Sub

Private Sub OptionButton2_Click()
Calculer_Total
End Sub

Private Sub OptionButton3_Click()
Calculer_Total
End Sub

Private Sub txt_Temps_Change()
If UCase(txt_Temps.Text) = "A" Then txt_Temps.Text = "AB"
End Sub

Private Sub txt_Temps_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Calculer_Pénalités
End Sub

Private Sub Calculer_Pénalités()
'temps renseigné ?
If txt_Temps.Text = "" Then
MsgBox "Renseigner le temps ou abandon !"
txt_Temps.SetFocus
Exit Sub
End If

'calcul pénalités
If txt_Temps.Text = "AB" Then
txt_Pénalités.Caption = "ABANDON"
Exit Sub
End If
xAccordé = Val(Str(txt_Accordé.Caption))
xLimite = Val(Str(txt_Limite.Caption))
xTemps = Replace(txt_Temps.Value, ",", "")
xTemps = Val(Str(xTemps)) / 100

If xTemps < xAccordé Then
txt_Pénalités.Caption = 0
Exit Sub
End If

If xTemps < xLimite Then
delta = (xTemps - xAccordé) 'différence
P_Entier = Int(delta) 'partie entière
P_Décim = delta - P_Entier 'partie décimale

If P_Décim > 0 Then
xPénalités = P_Entier * 0.25 + 0.25
Else
xPénalités = P_Entier * 0.25
End If
txt_Pénalités.Caption = Format(xPénalités, "##0.00")
txt_Temps.Text = Format(xTemps, "##0.00")
Else
txt_Pénalités.Caption = "ELIMINE"
End If
End Sub

Private Sub txt_Temps_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
'gestion des touches frappées
If txt_Temps.Text = "AB" Or txt_Temps.Text = "A" Or txt_Temps.Text = "B"
Then
MsgBox "Effacer la mention avant de modifier !"
Exit Sub
End If
Select Case KeyAscii
Case 65, 97
'a ou A pour abandon
Case 48 To 57
'OK, chiffres de 0 à 9
If InStr(txt_Temps.Text, ",") > 0 Then
nbdecimale = Len(txt_Temps.Text) - InStr(txt_Temps.Text, ",")
If nbdecimale >= 2 Then
KeyAscii = Asc(Chr(8))
End If
End If
'Case 44
'If InStr(txt_Temps.Text, ",") = 0 Then
' KeyAscii = Asc(Chr(44))
'Else
' KeyAscii = Asc(Chr(8))
'End If
'Case 46
'point changé en virgule
'If InStr(txt_Temps.Text, ",") = 0 Then
' KeyAscii = Asc(Chr(44))
'Else
' KeyAscii = Asc(Chr(8))
'End If
Case Else
KeyAscii = Asc(Chr(8))
End Select
End Sub

Private Sub UserForm_Activate()
'quelle ligne a déclenché l'affichage ?
lig = ActiveCell.Row
'initialiser les contrôles checkbox obstacles franchis
Init_Obstacles
'données numéro, cavalier, cheval
lbl_Numéro.Caption = ""
lbl_Cavalier.Caption = ""
lbl_Cheval.Caption = ""
'charger la liste des participants
Liste_Participants
'affiche numéro, cavalier, cheval
lst_Participants.ListIndex = lig - 10
'temps accordé et temps limite
txt_Accordé.Caption = Format(Range("A6").Value / 100, "##0.00")
txt_Limite.Caption = Format(Range("B6").Value / 100, "##0.00")
txt_Pénalités.Caption = Format(0, "##0.00")
End Sub

Private Sub Init_Obstacles()
For i = 1 To 9
Me.Controls("Checkbox" & i).Value = True
Next i
'aucun refus par défaut
opt_Refus_0.Value = True
'dernier obstacle
OptionButton1.Value = False 'joker OK
OptionButton2.Value = False 'obstacle 10
OptionButton3.Value = False 'joker pas OK
End Sub

Private Sub Liste_Participants()
Sheets("Participants").Activate
der = Range("A500").End(xlUp).Row
If der = 10 Then
MsgBox "La liste des participants est vide !!!"
Exit Sub
End If

Range("A10").Select
lst_Participants.Clear
Do While ActiveCell.Value <> ""
lst_Participants.AddItem
ndx = lst_Participants.ListCount - 1
lst_Participants.List(ndx, 0) = ActiveCell.Value
'numéro
lst_Participants.List(ndx, 1) = ActiveCell.Offset(0, 1).Value
'cavalier
lst_Participants.List(ndx, 2) = ActiveCell.Offset(0, 2).Value
'cheval
ActiveCell.Offset(1, 0).Select
Loop
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
'éxecute la procédure du bouton Quitter
CommandButton2_Click
End Sub

Bonjour,
je me permets quelque suggestions :

concernant les penalites de temps faut-il retirer 0.25 pt par seconde
depassees
ou 0.0025 pt par centieme de seconde. D'apres ce que je comprends
il s'agit de 0.0025 pt par centieme de seconde.
Pour avoir le bon nombre des penalites il faut que xPénalités soit de type
Double.

Ecrire
Range("E" & ndx).Value = format(txt_temps.text,"##'##''")

au lieu de

Range("E" & ndx).Select
With ActiveCell
.Value = Val(Str(txt_Temps.Text)) * 100
.NumberFormat = "##"" ' ""##"" '' """
End With

Ecrire :
If xTemps>=xLimite then
Total™99
txt_Pénalités.caption="ELIMINE"
Exit sub
Endif
xPénalités=0
if xTemps>=xAccordés then xPénalités=0.25*(1+(xTemps-XAccordé))
txt_Pénalités.Caption = Format(xPénalités, "##0.00")
txt_Temps.Text = Format(xTemps, "##0.00")

au lieu de

If xTemps < xAccordé Then
txt_Pénalités.Caption = 0
Exit Sub
End If

If xTemps < xLimite Then
delta = (xTemps - xAccordé) 'différence
P_Entier = Int(delta) 'partie entière
P_Décim = delta - P_Entier 'partie décimale

If P_Décim > 0 Then
xPénalités = P_Entier * 0.25 + 0.25
Else
xPénalités = P_Entier * 0.25
End If
txt_Pénalités.Caption = Format(xPénalités, "##0.00")
txt_Temps.Text = Format(xTemps, "##0.00")
Else
txt_Pénalités.Caption = "ELIMINE"
End If

Bonjour,

Claude Trouet que je remerci encore m'a permis d'avancer dans mon projet.
Cependant et malgré ses conseils (utilisation de l'enregistreur de macros)je
ne parviens pas à débugger la fin du programme. Je reprends donc
l'explication:

Toutes les cellules contenant des temps sont au format personnalise suivant:
##" ' "##" '' "

Les cellules contenant des éventuelles pénalités de temps (colonne F) sont
au format personnalisé suivant:[>=2]0,00" pts";0,00" pt"_s

Les cellules contenant les points du parcours (colonne G) et le total des
énalités éventuelles de temps et des points parcours (colonne H) sont au
format personnalisé suivant: [>=2]0,00" pts";[Rouge]0,00" pt"_s

Le temps accordé est en A6 et le temps limite en B6 au format personnalisé
suivant
##" ' "##" '' "

1) Au lieu d'afficher dans le userform uniquement le total des points obtenu
aux obstacles uniquement sans tenir compte des pénalités de temps j'aimerais
afficher ce dernier.
Total points = total points obtenus aux différents obstacles - refus -
éventuelles pénalités de temps
NB: Le total des points obtenu aux obstacles continuant de se reporter en
colonne G. Il s'agit uniquement de modifier (ou de rajouter) une case au
userform

2) Il y a une petite erreur dans le calcul des pénalités de temps. En effet
il y a une pénalités de temps pour toute seconde ou fraction de seconde
entamée.
ex: Si on a un temps accordé de 86'00'' et que le concurrent met 86'00''
pour effectuer son parcours il doit être pénalisé de 0,25 pt. S'il met
87'00'' il sera pénalisé de 0,50 pt

3)Il y a enfin une petite erreur dans l'affichage de la colonne D (le temps
mis par le concurrent pour effectuer son parcours) L'userform lorsque le
temps est strictement inférieur au temps accordé renoit le temps multiplié
par 100
ex au lieu de renvoyer 5829 (ce qui compte tenu du format personnalisé
affiche dans la cellule 58'29'') il renvoit 582900 (donc à l'affichage
5829'00'')

Merci
Voila mon code actuel mais si quelqu'un préfère je peux lui envoyer le
fichier (jé préférerais)

Private Sub CheckBox1_Change()
Calculer_Total
End Sub

Private Sub CheckBox2_Change()
Calculer_Total
End Sub

Private Sub CheckBox3_Change()
Calculer_Total
End Sub

Private Sub CheckBox4_Change()
Calculer_Total
End Sub

Private Sub CheckBox5_Change()
Calculer_Total
End Sub

Private Sub CheckBox6_Change()
Calculer_Total
End Sub

Private Sub CheckBox7_Change()
Calculer_Total
End Sub

Private Sub CheckBox8_Change()
Calculer_Total
End Sub

Private Sub CheckBox9_Change()
Calculer_Total
End Sub

Private Sub Calculer_Total()
Total = 0
'gestion des refus 9999 si + de 2 refus
If opt_Refus_1.Value = True Then Total = Total - 4
If opt_Refus_2.Value = True Then Total = Total - 8
If opt_Refus_3.Value = True Then
Total = 9999
txt_Points.Caption = "ELIMINE"
Exit Sub
End If

'Total si moins de 3 refus
If CheckBox1.Value = True Then Total = Total + 1
If CheckBox2.Value = True Then Total = Total + 2
If CheckBox3.Value = True Then Total = Total + 3
If CheckBox4.Value = True Then Total = Total + 4
If CheckBox5.Value = True Then Total = Total + 5
If CheckBox6.Value = True Then Total = Total + 6
If CheckBox7.Value = True Then Total = Total + 7
If CheckBox8.Value = True Then Total = Total + 8
If CheckBox9.Value = True Then Total = Total + 9

'OK, une des 3 option est sélectionnée
If OptionButton1.Value = True Then Total = Total + 20
If OptionButton2.Value = True Then Total = Total + 10
If OptionButton3.Value = True Then Total = Total - 20
'mettre à jour la case Total
txt_Points.Caption = Format(Total, "##0.00")
End Sub

Private Sub CommandButton1_Click()
Dim Total
Total = Val(txt_Points.Caption)
'contrôle qu'un participant est sélectionné
If lst_Participants.ListIndex = -1 Then
MsgBox "Sélectionner un participant !"
Exit Sub
End If

'calcul du Total
Calculer_Total

'calcule les pénalités ( cas clic direct sur bouton OK )
If Total <> 9999 Then Calculer_Pénalités

'gestion du temps mis
Select Case txt_Temps.Text
Case "AB"
Total = 9999
Case ""
If Total <> 9999 Then
MsgBox "Préciser le temps mis ou abandon !"
txt_Temps.SetFocus
Exit Sub
End If
Case Else
If txt_Pénalités.Caption = "ELIMINE" Then
Total = 9999
Else
Total = Total - Val(txt_Pénalités.Caption)
End If
End Select

If Total <> 9999 Then
'vérifie qu'une des 3 options est sélectionnée
If OptionButton1.Value = False _
And OptionButton2.Value = False _
And OptionButton3.Value = False Then
MsgBox "Vous n'avez pas renseigné le dernier obstacle!"
Exit Sub
End If
End If

'Résultat dans la cellule
'la ligne est celle correspondant à l'index dans la liste +10
ndx = lst_Participants.ListIndex + 10
Range("G" & ndx).Select
If Total <> 9999 Then
'total des points
ActiveCell.Value = Format(txt_Points.Caption, "##0")
'temps
Range("E" & ndx).Select
With ActiveCell
.Value = Val(Str(txt_Temps.Text)) * 100
.NumberFormat = "##"" ' ""##"" '' """
End With
'Pénalités
Range("F" & ndx).Select
With ActiveCell
.Value = Val(Str(txt_Pénalités.Caption))
.NumberFormat = "[>=2]0.00"" pts"";0.00"" pt""_s"
If ActiveCell.Value = 0 Then ActiveCell = ""
End With
'Colonne H somme des points - pénalités
MaSomme = Val(Str(txt_Points.Caption)) -
Val(Str(txt_Pénalités.Caption))
Range("H" & ndx).Select
With ActiveCell
.Value = MaSomme
.NumberFormat = "[>=2]0.00"" pts"";[Red]0.00"" pt""_s"
End With
Else
Range("G" & ndx).Select
If txt_Temps.Text = "AB" Then 'abandon
ActiveCell.Value = "AB"
Else
ActiveCell.Value = "EL"
End If
'vide les cellules en E, F et H
Range("E" & ndx).Value = ""
Range("F" & ndx).Value = ""
Range("H" & ndx).Value = ""
End If
End Sub

Private Sub CommandButton2_Click()
'première cellule vide de la colonne G à partir ligne 10
Sheets("Participants").Activate
Range("G10").Select
Do While ActiveCell.Value <> "" 'boucle tant que cellule est non
vide
ActiveCell.Offset(1, 0).Select 'ligne du dessous
Loop
Hide
End Sub

Private Sub lst_Participants_Change()
'renseigner le numéro, le cavalier et le cheval
If lst_Participants.ListIndex = -1 Then
'réinitialiser les checkbox, etc
lbl_Numéro.Caption = ""
lbl_Cavalier.Caption = ""
lbl_Cheval.Caption = ""
Else
Init_Obstacles
lbl_Numéro.Caption =
lst_Participants.List(lst_Participants.ListIndex, 0)
lbl_Cavalier.Caption =
lst_Participants.List(lst_Participants.ListIndex, 2)
lbl_Cheval.Caption =
lst_Participants.List(lst_Participants.ListIndex, 1)
End If
End Sub


Private Sub TextBox1_Change()
TextBox1 = MaSomme
End Sub


Private Sub opt_Refus_0_Click()
Calculer_Total
End Sub

Private Sub opt_Refus_1_Click()
Calculer_Total
End Sub

Private Sub opt_Refus_2_Click()
Calculer_Total
End Sub

Private Sub opt_Refus_3_Click()
Calculer_Total
End Sub

Private Sub OptionButton1_Click()
Calculer_Total
End Sub

Private Sub OptionButton2_Click()
Calculer_Total
End Sub

Private Sub OptionButton3_Click()
Calculer_Total
End Sub

Private Sub txt_Temps_Change()
If UCase(txt_Temps.Text) = "A" Then txt_Temps.Text = "AB"
End Sub

Private Sub txt_Temps_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Calculer_Pénalités
End Sub

Private Sub Calculer_Pénalités()
'temps renseigné ?
If txt_Temps.Text = "" Then
MsgBox "Renseigner le temps ou abandon !"
txt_Temps.SetFocus
Exit Sub
End If

'calcul pénalités
If txt_Temps.Text = "AB" Then
txt_Pénalités.Caption = "ABANDON"
Exit Sub
End If
xAccordé = Val(Str(txt_Accordé.Caption))
xLimite = Val(Str(txt_Limite.Caption))
xTemps = Replace(txt_Temps.Value, ",", "")
xTemps = Val(Str(xTemps)) / 100

If xTemps < xAccordé Then
txt_Pénalités.Caption = 0
Exit Sub
End If

If xTemps < xLimite Then
delta = (xTemps - xAccordé) 'différence
P_Entier = Int(delta) 'partie entière
P_Décim = delta - P_Entier 'partie décimale

If P_Décim > 0 Then
xPénalités = P_Entier * 0.25 + 0.25
Else
xPénalités = P_Entier * 0.25
End If
txt_Pénalités.Caption = Format(xPénalités, "##0.00")
txt_Temps.Text = Format(xTemps, "##0.00")
Else
txt_Pénalités.Caption = "ELIMINE"
End If
End Sub

Private Sub txt_Temps_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
'gestion des touches frappées
If txt_Temps.Text = "AB" Or txt_Temps.Text = "A" Or txt_Temps.Text = "B"
Then
MsgBox "Effacer la mention avant de modifier !"
Exit Sub
End If
Select Case KeyAscii
Case 65, 97
'a ou A pour abandon
Case 48 To 57
'OK, chiffres de 0 à 9
If InStr(txt_Temps.Text, ",") > 0 Then
nbdecimale = Len(txt_Temps.Text) - InStr(txt_Temps.Text, ",")
If nbdecimale >= 2 Then
KeyAscii = Asc(Chr(8))
End If
End If
'Case 44
'If InStr(txt_Temps.Text, ",") = 0 Then
' KeyAscii = Asc(Chr(44))
'Else
' KeyAscii = Asc(Chr(8))
'End If
'Case 46
'point changé en virgule
'If InStr(txt_Temps.Text, ",") = 0 Then
' KeyAscii = Asc(Chr(44))
'Else
' KeyAscii = Asc(Chr(8))
'End If
Case Else
KeyAscii = Asc(Chr(8))
End Select
End Sub

Private Sub UserForm_Activate()
'quelle ligne a déclenché l'affichage ?
lig = ActiveCell.Row
'initialiser les contrôles checkbox obstacles franchis
Init_Obstacles
'données numéro, cavalier, cheval
lbl_Numéro.Caption = ""
lbl_Cavalier.Caption = ""
lbl_Cheval.Caption = ""
'charger la liste des participants
Liste_Participants
'affiche numéro, cavalier, cheval
lst_Participants.ListIndex = lig - 10
'temps accordé et temps limite
txt_Accordé.Caption = Format(Range("A6").Value / 100, "##0.00")
txt_Limite.Caption = Format(Range("B6").Value / 100, "##0.00")
txt_Pénalités.Caption = Format(0, "##0.00")
End Sub

Private Sub Init_Obstacles()
For i = 1 To 9
Me.Controls("Checkbox" & i).Value = True
Next i
'aucun refus par défaut
opt_Refus_0.Value = True
'dernier obstacle
OptionButton1.Value = False 'joker OK
OptionButton2.Value = False 'obstacle 10
OptionButton3.Value = False 'joker pas OK
End Sub

Private Sub Liste_Participants()
Sheets("Participants").Activate
der = Range("A500").End(xlUp).Row
If der = 10 Then
MsgBox "La liste des participants est vide !!!"
Exit Sub
End If

Range("A10").Select
lst_Participants.Clear
Do While ActiveCell.Value <> ""
lst_Participants.AddItem
ndx = lst_Participants.ListCount - 1
lst_Participants.List(ndx, 0) = ActiveCell.Value
'numéro
lst_Participants.List(ndx, 1) = ActiveCell.Offset(0, 1).Value
'cavalier
lst_Participants.List(ndx, 2) = ActiveCell.Offset(0, 2).Value
'cheval
ActiveCell.Offset(1, 0).Select
Loop
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
'éxecute la procédure du bouton Quitter
CommandButton2_Click
End Sub

Bonjour,

Oui il faut retirer 0,25 pt par seconde. Le calcul des pénalités de temps
était exact. Le problème concernait entre autre l'affichage du temps.
Je pense qu'il serait peut être plus simple que je t'envoi le fichier si tu
veux bien.
Merci

Bonjour,
je me permets quelque suggestions :

concernant les penalites de temps faut-il retirer 0.25 pt par seconde
depassees
ou 0.0025 pt par centieme de seconde. D'apres ce que je comprends
il s'agit de 0.0025 pt par centieme de seconde.
Pour avoir le bon nombre des penalites il faut que xPénalités soit de type
Double.

Ecrire
Range("E" & ndx).Value = format(txt_temps.text,"##'##''")

au lieu de

Range("E" & ndx).Select
With ActiveCell
.Value = Val(Str(txt_Temps.Text)) * 100
.NumberFormat = "##"" ' ""##"" '' """
End With

Ecrire :
If xTemps>=xLimite then
Total™99
txt_Pénalités.caption="ELIMINE"
Exit sub
Endif
xPénalités=0
if xTemps>=xAccordés then xPénalités=0.25*(1+(xTemps-XAccordé))
txt_Pénalités.Caption = Format(xPénalités, "##0.00")
txt_Temps.Text = Format(xTemps, "##0.00")

au lieu de

If xTemps < xAccordé Then
txt_Pénalités.Caption = 0
Exit Sub
End If

If xTemps < xLimite Then
delta = (xTemps - xAccordé) 'différence
P_Entier = Int(delta) 'partie entière
P_Décim = delta - P_Entier 'partie décimale

If P_Décim > 0 Then
xPénalités = P_Entier * 0.25 + 0.25
Else
xPénalités = P_Entier * 0.25
End If
txt_Pénalités.Caption = Format(xPénalités, "##0.00")
txt_Temps.Text = Format(xTemps, "##0.00")
Else
txt_Pénalités.Caption = "ELIMINE"
End If

Bonjour,

Claude Trouet que je remerci encore m'a permis d'avancer dans mon projet.
Cependant et malgré ses conseils (utilisation de l'enregistreur de macros)je
ne parviens pas à débugger la fin du programme. Je reprends donc
l'explication:

Toutes les cellules contenant des temps sont au format personnalise suivant:
##" ' "##" '' "

Les cellules contenant des éventuelles pénalités de temps (colonne F) sont
au format personnalisé suivant:[>=2]0,00" pts";0,00" pt"_s

Les cellules contenant les points du parcours (colonne G) et le total des
énalités éventuelles de temps et des points parcours (colonne H) sont au
format personnalisé suivant: [>=2]0,00" pts";[Rouge]0,00" pt"_s

Le temps accordé est en A6 et le temps limite en B6 au format personnalisé
suivant
##" ' "##" '' "

1) Au lieu d'afficher dans le userform uniquement le total des points obtenu
aux obstacles uniquement sans tenir compte des pénalités de temps j'aimerais
afficher ce dernier.
Total points = total points obtenus aux différents obstacles - refus -
éventuelles pénalités de temps
NB: Le total des points obtenu aux obstacles continuant de se reporter en
colonne G. Il s'agit uniquement de modifier (ou de rajouter) une case au
userform

2) Il y a une petite erreur dans le calcul des pénalités de temps. En effet
il y a une pénalités de temps pour toute seconde ou fraction de seconde
entamée.
ex: Si on a un temps accordé de 86'00'' et que le concurrent met 86'00''
pour effectuer son parcours il doit être pénalisé de 0,25 pt. S'il met
87'00'' il sera pénalisé de 0,50 pt

3)Il y a enfin une petite erreur dans l'affichage de la colonne D (le temps
mis par le concurrent pour effectuer son parcours) L'userform lorsque le
temps est strictement inférieur au temps accordé renoit le temps multiplié
par 100
ex au lieu de renvoyer 5829 (ce qui compte tenu du format personnalisé
affiche dans la cellule 58'29'') il renvoit 582900 (donc à l'affichage
5829'00'')

Merci
Voila mon code actuel mais si quelqu'un préfère je peux lui envoyer le
fichier (jé préférerais)

Private Sub CheckBox1_Change()
Calculer_Total
End Sub

Private Sub CheckBox2_Change()
Calculer_Total
End Sub

Private Sub CheckBox3_Change()
Calculer_Total
End Sub

Private Sub CheckBox4_Change()
Calculer_Total
End Sub

Private Sub CheckBox5_Change()
Calculer_Total
End Sub

Private Sub CheckBox6_Change()
Calculer_Total
End Sub

Private Sub CheckBox7_Change()
Calculer_Total
End Sub

Private Sub CheckBox8_Change()
Calculer_Total
End Sub

Private Sub CheckBox9_Change()
Calculer_Total
End Sub

Private Sub Calculer_Total()
Total = 0
'gestion des refus 9999 si + de 2 refus
If opt_Refus_1.Value = True Then Total = Total - 4
If opt_Refus_2.Value = True Then Total = Total - 8
If opt_Refus_3.Value = True Then
Total = 9999
txt_Points.Caption = "ELIMINE"
Exit Sub
End If

'Total si moins de 3 refus
If CheckBox1.Value = True Then Total = Total + 1
If CheckBox2.Value = True Then Total = Total + 2
If CheckBox3.Value = True Then Total = Total + 3
If CheckBox4.Value = True Then Total = Total + 4
If CheckBox5.Value = True Then Total = Total + 5
If CheckBox6.Value = True Then Total = Total + 6
If CheckBox7.Value = True Then Total = Total + 7
If CheckBox8.Value = True Then Total = Total + 8
If CheckBox9.Value = True Then Total = Total + 9

'OK, une des 3 option est sélectionnée
If OptionButton1.Value = True Then Total = Total + 20
If OptionButton2.Value = True Then Total = Total + 10
If OptionButton3.Value = True Then Total = Total - 20
'mettre à jour la case Total
txt_Points.Caption = Format(Total, "##0.00")
End Sub

Private Sub CommandButton1_Click()
Dim Total
Total = Val(txt_Points.Caption)
'contrôle qu'un participant est sélectionné
If lst_Participants.ListIndex = -1 Then
MsgBox "Sélectionner un participant !"
Exit Sub
End If

'calcul du Total
Calculer_Total

'calcule les pénalités ( cas clic direct sur bouton OK )
If Total <> 9999 Then Calculer_Pénalités

'gestion du temps mis
Select Case txt_Temps.Text
Case "AB"
Total = 9999
Case ""
If Total <> 9999 Then
MsgBox "Préciser le temps mis ou abandon !"
txt_Temps.SetFocus
Exit Sub
End If
Case Else
If txt_Pénalités.Caption = "ELIMINE" Then
Total = 9999
Else
Total = Total - Val(txt_Pénalités.Caption)
End If
End Select

If Total <> 9999 Then
'vérifie qu'une des 3 options est sélectionnée
If OptionButton1.Value = False _
And OptionButton2.Value = False _
And OptionButton3.Value = False Then
MsgBox "Vous n'avez pas renseigné le dernier obstacle!"
Exit Sub
End If
End If

'Résultat dans la cellule
'la ligne est celle correspondant à l'index dans la liste +10
ndx = lst_Participants.ListIndex + 10
Range("G" & ndx).Select
If Total <> 9999 Then
'total des points
ActiveCell.Value = Format(txt_Points.Caption, "##0")
'temps
Range("E" & ndx).Select
With ActiveCell
.Value = Val(Str(txt_Temps.Text)) * 100
.NumberFormat = "##"" ' ""##"" '' """
End With
'Pénalités
Range("F" & ndx).Select
With ActiveCell
.Value = Val(Str(txt_Pénalités.Caption))
.NumberFormat = "[>=2]0.00"" pts"";0.00"" pt""_s"
If ActiveCell.Value = 0 Then ActiveCell = ""
End With
'Colonne H somme des points - pénalités
MaSomme = Val(Str(txt_Points.Caption)) -
Val(Str(txt_Pénalités.Caption))
Range("H" & ndx).Select
With ActiveCell
.Value = MaSomme
.NumberFormat = "[>=2]0.00"" pts"";[Red]0.00"" pt""_s"
End With
Else
Range("G" & ndx).Select
If txt_Temps.Text = "AB" Then 'abandon
ActiveCell.Value = "AB"
Else
ActiveCell.Value = "EL"
End If
'vide les cellules en E, F et H
Range("E" & ndx).Value = ""
Range("F" & ndx).Value = ""
Range("H" & ndx).Value = ""
End If
End Sub

Private Sub CommandButton2_Click()
'première cellule vide de la colonne G à partir ligne 10
Sheets("Participants").Activate
Range("G10").Select
Do While ActiveCell.Value <> "" 'boucle tant que cellule est non
vide
ActiveCell.Offset(1, 0).Select 'ligne du dessous
Loop
Hide
End Sub

Private Sub lst_Participants_Change()
'renseigner le numéro, le cavalier et le cheval
If lst_Participants.ListIndex = -1 Then
'réinitialiser les checkbox, etc
lbl_Numéro.Caption = ""
lbl_Cavalier.Caption = ""
lbl_Cheval.Caption = ""
Else
Init_Obstacles
lbl_Numéro.Caption =
lst_Participants.List(lst_Participants.ListIndex, 0)
lbl_Cavalier.Caption =
lst_Participants.List(lst_Participants.ListIndex, 2)
lbl_Cheval.Caption =
lst_Participants.List(lst_Participants.ListIndex, 1)
End If
End Sub


Private Sub TextBox1_Change()
TextBox1 = MaSomme
End Sub


Private Sub opt_Refus_0_Click()
Calculer_Total
End Sub

Private Sub opt_Refus_1_Click()
Calculer_Total
End Sub

Private Sub opt_Refus_2_Click()
Calculer_Total
End Sub

Private Sub opt_Refus_3_Click()
Calculer_Total
End Sub

Private Sub OptionButton1_Click()
Calculer_Total
End Sub

Private Sub OptionButton2_Click()
Calculer_Total
End Sub

Private Sub OptionButton3_Click()
Calculer_Total
End Sub

Private Sub txt_Temps_Change()
If UCase(txt_Temps.Text) = "A" Then txt_Temps.Text = "AB"
End Sub

Private Sub txt_Temps_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Calculer_Pénalités
End Sub

Private Sub Calculer_Pénalités()
'temps renseigné ?
If txt_Temps.Text = "" Then
MsgBox "Renseigner le temps ou abandon !"
txt_Temps.SetFocus
Exit Sub
End If

'calcul pénalités
If txt_Temps.Text = "AB" Then
txt_Pénalités.Caption = "ABANDON"
Exit Sub
End If
xAccordé = Val(Str(txt_Accordé.Caption))
xLimite = Val(Str(txt_Limite.Caption))
xTemps = Replace(txt_Temps.Value, ",", "")
xTemps = Val(Str(xTemps)) / 100

If xTemps < xAccordé Then
txt_Pénalités.Caption = 0
Exit Sub
End If

If xTemps < xLimite Then
delta = (xTemps - xAccordé) 'différence
P_Entier = Int(delta) 'partie entière
P_Décim = delta - P_Entier 'partie décimale

If P_Décim > 0 Then
xPénalités = P_Entier * 0.25 + 0.25
Else
xPénalités = P_Entier * 0.25
End If
txt_Pénalités.Caption = Format(xPénalités, "##0.00")
txt_Temps.Text = Format(xTemps, "##0.00")
Else
txt_Pénalités.Caption = "ELIMINE"
End If
End Sub

Private Sub txt_Temps_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
'gestion des touches frappées
If txt_Temps.Text = "AB" Or txt_Temps.Text = "A" Or txt_Temps.Text = "B"
Then
MsgBox "Effacer la mention avant de modifier !"
Exit Sub
End If
Select Case KeyAscii
Case 65, 97
'a ou A pour abandon
Case 48 To 57
'OK, chiffres de 0 à 9
If InStr(txt_Temps.Text, ",") > 0 Then
nbdecimale = Len(txt_Temps.Text) - InStr(txt_Temps.Text, ",")
If nbdecimale >= 2 Then
KeyAscii = Asc(Chr(8))
End If
End If
'Case 44
'If InStr(txt_Temps.Text, ",") = 0 Then
' KeyAscii = Asc(Chr(44))
'Else
' KeyAscii = Asc(Chr(8))
'End If
'Case 46
'point changé en virgule
'If InStr(txt_Temps.Text, ",") = 0 Then
' KeyAscii = Asc(Chr(44))
'Else
' KeyAscii = Asc(Chr(8))
'End If
Case Else
KeyAscii = Asc(Chr(8))
End Select
End Sub

Private Sub UserForm_Activate()
'quelle ligne a déclenché l'affichage ?
lig = ActiveCell.Row
'initialiser les contrôles checkbox obstacles franchis
Init_Obstacles
'données numéro, cavalier, cheval
lbl_Numéro.Caption = ""
lbl_Cavalier.Caption = ""
lbl_Cheval.Caption = ""
'charger la liste des participants
Liste_Participants
'affiche numéro, cavalier, cheval
lst_Participants.ListIndex = lig - 10
'temps accordé et temps limite
txt_Accordé.Caption = Format(Range("A6").Value / 100, "##0.00")
txt_Limite.Caption = Format(Range("B6").Value / 100, "##0.00")
txt_Pénalités.Caption = Format(0, "##0.00")
End Sub

Private Sub Init_Obstacles()
For i = 1 To 9
Me.Controls("Checkbox" & i).Value = True
Next i
'aucun refus par défaut
opt_Refus_0.Value = True
'dernier obstacle
OptionButton1.Value = False 'joker OK
OptionButton2.Value = False 'obstacle 10
OptionButton3.Value = False 'joker pas OK
End Sub

Private Sub Liste_Participants()
Sheets("Participants").Activate
der = Range("A500").End(xlUp).Row
If der = 10 Then
MsgBox "La liste des participants est vide !!!"
Exit Sub
End If

Range("A10").Select
lst_Participants.Clear
Do While ActiveCell.Value <> ""
lst_Participants.AddItem
ndx = lst_Participants.ListCount - 1
lst_Participants.List(ndx, 0) = ActiveCell.Value
'numéro
lst_Participants.List(ndx, 1) = ActiveCell.Offset(0, 1).Value
'cavalier
lst_Participants.List(ndx, 2) = ActiveCell.Offset(0, 2).Value
'cheval
ActiveCell.Offset(1, 0).Select
Loop
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
'éxecute la procédure du bouton Quitter
CommandButton2_Click
End Sub

Pourquoi pas.

ilankailli at hotmail point com

Bonjour,

Oui il faut retirer 0,25 pt par seconde. Le calcul des pénalités de temps
était exact. Le problème concernait entre autre l'affichage du temps.
Je pense qu'il serait peut être plus simple que je t'envoi le fichier si tu
veux bien.
Merci

Bonjour,
je me permets quelque suggestions :

concernant les penalites de temps faut-il retirer 0.25 pt par seconde
depassees
ou 0.0025 pt par centieme de seconde. D'apres ce que je comprends
il s'agit de 0.0025 pt par centieme de seconde.
Pour avoir le bon nombre des penalites il faut que xPénalités soit de type
Double.

Ecrire
Range("E" & ndx).Value = format(txt_temps.text,"##'##''")

au lieu de

Range("E" & ndx).Select
With ActiveCell
.Value = Val(Str(txt_Temps.Text)) * 100
.NumberFormat = "##"" ' ""##"" '' """
End With

Ecrire :
If xTemps>=xLimite then
Total™99
txt_Pénalités.caption="ELIMINE"
Exit sub
Endif
xPénalités=0
if xTemps>=xAccordés then xPénalités=0.25*(1+(xTemps-XAccordé))
txt_Pénalités.Caption = Format(xPénalités, "##0.00")
txt_Temps.Text = Format(xTemps, "##0.00")

au lieu de

If xTemps < xAccordé Then
txt_Pénalités.Caption = 0
Exit Sub
End If

If xTemps < xLimite Then
delta = (xTemps - xAccordé) 'différence
P_Entier = Int(delta) 'partie entière
P_Décim = delta - P_Entier 'partie décimale

If P_Décim > 0 Then
xPénalités = P_Entier * 0.25 + 0.25
Else
xPénalités = P_Entier * 0.25
End If
txt_Pénalités.Caption = Format(xPénalités, "##0.00")
txt_Temps.Text = Format(xTemps, "##0.00")
Else
txt_Pénalités.Caption = "ELIMINE"
End If

Bonjour,

Claude Trouet que je remerci encore m'a permis d'avancer dans mon projet.
Cependant et malgré ses conseils (utilisation de l'enregistreur de macros)je
ne parviens pas à débugger la fin du programme. Je reprends donc
l'explication:

Toutes les cellules contenant des temps sont au format personnalise suivant:
##" ' "##" '' "

Les cellules contenant des éventuelles pénalités de temps (colonne F) sont
au format personnalisé suivant:[>=2]0,00" pts";0,00" pt"_s

Les cellules contenant les points du parcours (colonne G) et le total des
énalités éventuelles de temps et des points parcours (colonne H) sont au
format personnalisé suivant: [>=2]0,00" pts";[Rouge]0,00" pt"_s

Le temps accordé est en A6 et le temps limite en B6 au format personnalisé
suivant
##" ' "##" '' "

1) Au lieu d'afficher dans le userform uniquement le total des points obtenu
aux obstacles uniquement sans tenir compte des pénalités de temps j'aimerais
afficher ce dernier.
Total points = total points obtenus aux différents obstacles - refus -
éventuelles pénalités de temps
NB: Le total des points obtenu aux obstacles continuant de se reporter en
colonne G. Il s'agit uniquement de modifier (ou de rajouter) une case au
userform

2) Il y a une petite erreur dans le calcul des pénalités de temps. En effet
il y a une pénalités de temps pour toute seconde ou fraction de seconde
entamée.
ex: Si on a un temps accordé de 86'00'' et que le concurrent met 86'00''
pour effectuer son parcours il doit être pénalisé de 0,25 pt. S'il met
87'00'' il sera pénalisé de 0,50 pt

3)Il y a enfin une petite erreur dans l'affichage de la colonne D (le temps
mis par le concurrent pour effectuer son parcours) L'userform lorsque le
temps est strictement inférieur au temps accordé renoit le temps multiplié
par 100
ex au lieu de renvoyer 5829 (ce qui compte tenu du format personnalisé
affiche dans la cellule 58'29'') il renvoit 582900 (donc à l'affichage
5829'00'')

Merci
Voila mon code actuel mais si quelqu'un préfère je peux lui envoyer le
fichier (jé préférerais)

Private Sub CheckBox1_Change()
Calculer_Total
End Sub

Private Sub CheckBox2_Change()
Calculer_Total
End Sub

Private Sub CheckBox3_Change()
Calculer_Total
End Sub

Private Sub CheckBox4_Change()
Calculer_Total
End Sub

Private Sub CheckBox5_Change()
Calculer_Total
End Sub

Private Sub CheckBox6_Change()
Calculer_Total
End Sub

Private Sub CheckBox7_Change()
Calculer_Total
End Sub

Private Sub CheckBox8_Change()
Calculer_Total
End Sub

Private Sub CheckBox9_Change()
Calculer_Total
End Sub

Private Sub Calculer_Total()
Total = 0
'gestion des refus 9999 si + de 2 refus
If opt_Refus_1.Value = True Then Total = Total - 4
If opt_Refus_2.Value = True Then Total = Total - 8
If opt_Refus_3.Value = True Then
Total = 9999
txt_Points.Caption = "ELIMINE"
Exit Sub
End If

'Total si moins de 3 refus
If CheckBox1.Value = True Then Total = Total + 1
If CheckBox2.Value = True Then Total = Total + 2
If CheckBox3.Value = True Then Total = Total + 3
If CheckBox4.Value = True Then Total = Total + 4
If CheckBox5.Value = True Then Total = Total + 5
If CheckBox6.Value = True Then Total = Total + 6
If CheckBox7.Value = True Then Total = Total + 7
If CheckBox8.Value = True Then Total = Total + 8
If CheckBox9.Value = True Then Total = Total + 9

'OK, une des 3 option est sélectionnée
If OptionButton1.Value = True Then Total = Total + 20
If OptionButton2.Value = True Then Total = Total + 10
If OptionButton3.Value = True Then Total = Total - 20
'mettre à jour la case Total
txt_Points.Caption = Format(Total, "##0.00")
End Sub

Private Sub CommandButton1_Click()
Dim Total
Total = Val(txt_Points.Caption)
'contrôle qu'un participant est sélectionné
If lst_Participants.ListIndex = -1 Then
MsgBox "Sélectionner un participant !"
Exit Sub
End If

'calcul du Total
Calculer_Total

'calcule les pénalités ( cas clic direct sur bouton OK )
If Total <> 9999 Then Calculer_Pénalités

'gestion du temps mis
Select Case txt_Temps.Text
Case "AB"
Total = 9999
Case ""
If Total <> 9999 Then
MsgBox "Préciser le temps mis ou abandon !"
txt_Temps.SetFocus
Exit Sub
End If
Case Else
If txt_Pénalités.Caption = "ELIMINE" Then
Total = 9999
Else
Total = Total - Val(txt_Pénalités.Caption)
End If
End Select

If Total <> 9999 Then
'vérifie qu'une des 3 options est sélectionnée
If OptionButton1.Value = False _
And OptionButton2.Value = False _
And OptionButton3.Value = False Then
MsgBox "Vous n'avez pas renseigné le dernier obstacle!"
Exit Sub
End If
End If

'Résultat dans la cellule
'la ligne est celle correspondant à l'index dans la liste +10
ndx = lst_Participants.ListIndex + 10
Range("G" & ndx).Select
If Total <> 9999 Then
'total des points
ActiveCell.Value = Format(txt_Points.Caption, "##0")
'temps
Range("E" & ndx).Select
With ActiveCell
.Value = Val(Str(txt_Temps.Text)) * 100
.NumberFormat = "##"" ' ""##"" '' """
End With
'Pénalités
Range("F" & ndx).Select
With ActiveCell
.Value = Val(Str(txt_Pénalités.Caption))
.NumberFormat = "[>=2]0.00"" pts"";0.00"" pt""_s"
If ActiveCell.Value = 0 Then ActiveCell = ""
End With
'Colonne H somme des points - pénalités
MaSomme = Val(Str(txt_Points.Caption)) -
Val(Str(txt_Pénalités.Caption))
Range("H" & ndx).Select
With ActiveCell
.Value = MaSomme
.NumberFormat = "[>=2]0.00"" pts"";[Red]0.00"" pt""_s"
End With
Else
Range("G" & ndx).Select
If txt_Temps.Text = "AB" Then 'abandon
ActiveCell.Value = "AB"
Else
ActiveCell.Value = "EL"
End If
'vide les cellules en E, F et H
Range("E" & ndx).Value = ""
Range("F" & ndx).Value = ""
Range("H" & ndx).Value = ""
End If
End Sub

Private Sub CommandButton2_Click()
'première cellule vide de la colonne G à partir ligne 10
Sheets("Participants").Activate
Range("G10").Select
Do While ActiveCell.Value <> "" 'boucle tant que cellule est non
vide
ActiveCell.Offset(1, 0).Select 'ligne du dessous
Loop
Hide
End Sub

Private Sub lst_Participants_Change()
'renseigner le numéro, le cavalier et le cheval
If lst_Participants.ListIndex = -1 Then
'réinitialiser les checkbox, etc
lbl_Numéro.Caption = ""
lbl_Cavalier.Caption = ""
lbl_Cheval.Caption = ""
Else
Init_Obstacles
lbl_Numéro.Caption =
lst_Participants.List(lst_Participants.ListIndex, 0)
lbl_Cavalier.Caption =
lst_Participants.List(lst_Participants.ListIndex, 2)
lbl_Cheval.Caption =
lst_Participants.List(lst_Participants.ListIndex, 1)
End If
End Sub


Private Sub TextBox1_Change()
TextBox1 = MaSomme
End Sub


Private Sub opt_Refus_0_Click()
Calculer_Total
End Sub

Private Sub opt_Refus_1_Click()
Calculer_Total
End Sub

Private Sub opt_Refus_2_Click()
Calculer_Total
End Sub

Private Sub opt_Refus_3_Click()
Calculer_Total
End Sub

Private Sub OptionButton1_Click()
Calculer_Total
End Sub

Private Sub OptionButton2_Click()
Calculer_Total
End Sub

Private Sub OptionButton3_Click()
Calculer_Total
End Sub

Private Sub txt_Temps_Change()
If UCase(txt_Temps.Text) = "A" Then txt_Temps.Text = "AB"
End Sub

Private Sub txt_Temps_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Calculer_Pénalités
End Sub

Private Sub Calculer_Pénalités()
'temps renseigné ?
If txt_Temps.Text = "" Then
MsgBox "Renseigner le temps ou abandon !"
txt_Temps.SetFocus
Exit Sub
End If

'calcul pénalités
If txt_Temps.Text = "AB" Then
txt_Pénalités.Caption = "ABANDON"
Exit Sub
End If
xAccordé = Val(Str(txt_Accordé.Caption))
xLimite = Val(Str(txt_Limite.Caption))
xTemps = Replace(txt_Temps.Value, ",", "")
xTemps = Val(Str(xTemps)) / 100

If xTemps < xAccordé Then
txt_Pénalités.Caption = 0
Exit Sub
End If

If xTemps < xLimite Then
delta = (xTemps - xAccordé) 'différence
P_Entier = Int(delta) 'partie entière
P_Décim = delta - P_Entier 'partie décimale

If P_Décim > 0 Then
xPénalités = P_Entier * 0.25 + 0.25
Else
xPénalités = P_Entier * 0.25
End If
txt_Pénalités.Caption = Format(xPénalités, "##0.00")
txt_Temps.Text = Format(xTemps, "##0.00")
Else
txt_Pénalités.Caption = "ELIMINE"
End If
End Sub

Private Sub txt_Temps_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
'gestion des touches frappées
If txt_Temps.Text = "AB" Or txt_Temps.Text = "A" Or txt_Temps.Text = "B"
Then
MsgBox "Effacer la mention avant de modifier !"
Exit Sub
End If
Select Case KeyAscii
Case 65, 97
'a ou A pour abandon
Case 48 To 57
'OK, chiffres de 0 à 9
If InStr(txt_Temps.Text, ",") > 0 Then
nbdecimale = Len(txt_Temps.Text) - InStr(txt_Temps.Text, ",")
If nbdecimale >= 2 Then
KeyAscii = Asc(Chr(8))
End If
End If
'Case 44
'If InStr(txt_Temps.Text, ",") = 0 Then
' KeyAscii = Asc(Chr(44))
'Else
' KeyAscii = Asc(Chr(8))
'End If
'Case 46
'point changé en virgule
'If InStr(txt_Temps.Text, ",") = 0 Then
' KeyAscii = Asc(Chr(44))
'Else
' KeyAscii = Asc(Chr(8))
'End If
Case Else
KeyAscii = Asc(Chr(8))
End Select
End Sub

Private Sub UserForm_Activate()
'quelle ligne a déclenché l'affichage ?
lig = ActiveCell.Row
'initialiser les contrôles checkbox obstacles franchis
Init_Obstacles
'données numéro, cavalier, cheval
lbl_Numéro.Caption = ""
lbl_Cavalier.Caption = ""
lbl_Cheval.Caption = ""
'charger la liste des participants
Liste_Participants
'affiche numéro, cavalier, cheval
lst_Participants.ListIndex = lig - 10
'temps accordé et temps limite
txt_Accordé.Caption = Format(Range("A6").Value / 100, "##0.00")
txt_Limite.Caption = Format(Range("B6").Value / 100, "##0.00")
txt_Pénalités.Caption = Format(0, "##0.00")
End Sub

Private Sub Init_Obstacles()
For i = 1 To 9
Me.Controls("Checkbox" & i).Value = True
Next i
'aucun refus par défaut
opt_Refus_0.Value = True
'dernier obstacle
OptionButton1.Value = False 'joker OK
OptionButton2.Value = False 'obstacle 10
OptionButton3.Value = False 'joker pas OK
End Sub

Private Sub Liste_Participants()
Sheets("Participants").Activate
der = Range("A500").End(xlUp).Row
If der = 10 Then
MsgBox "La liste des participants est vide !!!"
Exit Sub
End If

Range("A10").Select
lst_Participants.Clear
Do While ActiveCell.Value <> ""
lst_Participants.AddItem
ndx = lst_Participants.ListCount - 1
lst_Participants.List(ndx, 0) = ActiveCell.Value
'numéro
lst_Participants.List(ndx, 1) = ActiveCell.Offset(0, 1).Value
'cavalier
lst_Participants.List(ndx, 2) = ActiveCell.Offset(0, 2).Value
'cheval
ActiveCell.Offset(1, 0).Select
Loop
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
'éxecute la procédure du bouton Quitter
CommandButton2_Click
End Sub

Bonjour,
Je t'ai envoyé le fichier.
Merci

Pourquoi pas.

ilankailli at hotmail point com

Bonjour,

Oui il faut retirer 0,25 pt par seconde. Le calcul des pénalités de temps
était exact. Le problème concernait entre autre l'affichage du temps.
Je pense qu'il serait peut être plus simple que je t'envoi le fichier si tu
veux bien.
Merci

Bonjour,
je me permets quelque suggestions :

concernant les penalites de temps faut-il retirer 0.25 pt par seconde
depassees
ou 0.0025 pt par centieme de seconde. D'apres ce que je comprends
il s'agit de 0.0025 pt par centieme de seconde.
Pour avoir le bon nombre des penalites il faut que xPénalités soit de type
Double.

Ecrire
Range("E" & ndx).Value = format(txt_temps.text,"##'##''")

au lieu de

Range("E" & ndx).Select
With ActiveCell
.Value = Val(Str(txt_Temps.Text)) * 100
.NumberFormat = "##"" ' ""##"" '' """
End With

Ecrire :
If xTemps>=xLimite then
Total™99
txt_Pénalités.caption="ELIMINE"
Exit sub
Endif
xPénalités=0
if xTemps>=xAccordés then xPénalités=0.25*(1+(xTemps-XAccordé))
txt_Pénalités.Caption = Format(xPénalités, "##0.00")
txt_Temps.Text = Format(xTemps, "##0.00")

au lieu de

If xTemps < xAccordé Then
txt_Pénalités.Caption = 0
Exit Sub
End If

If xTemps < xLimite Then
delta = (xTemps - xAccordé) 'différence
P_Entier = Int(delta) 'partie entière
P_Décim = delta - P_Entier 'partie décimale

If P_Décim > 0 Then
xPénalités = P_Entier * 0.25 + 0.25
Else
xPénalités = P_Entier * 0.25
End If
txt_Pénalités.Caption = Format(xPénalités, "##0.00")
txt_Temps.Text = Format(xTemps, "##0.00")
Else
txt_Pénalités.Caption = "ELIMINE"
End If

Bonjour,

Claude Trouet que je remerci encore m'a permis d'avancer dans mon projet.
Cependant et malgré ses conseils (utilisation de l'enregistreur de macros)je
ne parviens pas à débugger la fin du programme. Je reprends donc
l'explication:

Toutes les cellules contenant des temps sont au format personnalise suivant:
##" ' "##" '' "

Les cellules contenant des éventuelles pénalités de temps (colonne F) sont
au format personnalisé suivant:[>=2]0,00" pts";0,00" pt"_s

Les cellules contenant les points du parcours (colonne G) et le total des
énalités éventuelles de temps et des points parcours (colonne H) sont au
format personnalisé suivant: [>=2]0,00" pts";[Rouge]0,00" pt"_s

Le temps accordé est en A6 et le temps limite en B6 au format personnalisé
suivant
##" ' "##" '' "

1) Au lieu d'afficher dans le userform uniquement le total des points obtenu
aux obstacles uniquement sans tenir compte des pénalités de temps j'aimerais
afficher ce dernier.
Total points = total points obtenus aux différents obstacles - refus -
éventuelles pénalités de temps
NB: Le total des points obtenu aux obstacles continuant de se reporter en
colonne G. Il s'agit uniquement de modifier (ou de rajouter) une case au
userform

2) Il y a une petite erreur dans le calcul des pénalités de temps. En effet
il y a une pénalités de temps pour toute seconde ou fraction de seconde
entamée.
ex: Si on a un temps accordé de 86'00'' et que le concurrent met 86'00''
pour effectuer son parcours il doit être pénalisé de 0,25 pt. S'il met
87'00'' il sera pénalisé de 0,50 pt

3)Il y a enfin une petite erreur dans l'affichage de la colonne D (le temps
mis par le concurrent pour effectuer son parcours) L'userform lorsque le
temps est strictement inférieur au temps accordé renoit le temps multiplié
par 100
ex au lieu de renvoyer 5829 (ce qui compte tenu du format personnalisé
affiche dans la cellule 58'29'') il renvoit 582900 (donc à l'affichage
5829'00'')

Merci
Voila mon code actuel mais si quelqu'un préfère je peux lui envoyer le
fichier (jé préférerais)

Private Sub CheckBox1_Change()
Calculer_Total
End Sub

Private Sub CheckBox2_Change()
Calculer_Total
End Sub

Private Sub CheckBox3_Change()
Calculer_Total
End Sub

Private Sub CheckBox4_Change()
Calculer_Total
End Sub

Private Sub CheckBox5_Change()
Calculer_Total
End Sub

Private Sub CheckBox6_Change()
Calculer_Total
End Sub

Private Sub CheckBox7_Change()
Calculer_Total
End Sub

Private Sub CheckBox8_Change()
Calculer_Total
End Sub

Private Sub CheckBox9_Change()
Calculer_Total
End Sub

Private Sub Calculer_Total()
Total = 0
'gestion des refus 9999 si + de 2 refus
If opt_Refus_1.Value = True Then Total = Total - 4
If opt_Refus_2.Value = True Then Total = Total - 8
If opt_Refus_3.Value = True Then
Total = 9999
txt_Points.Caption = "ELIMINE"
Exit Sub
End If

'Total si moins de 3 refus
If CheckBox1.Value = True Then Total = Total + 1
If CheckBox2.Value = True Then Total = Total + 2
If CheckBox3.Value = True Then Total = Total + 3
If CheckBox4.Value = True Then Total = Total + 4
If CheckBox5.Value = True Then Total = Total + 5
If CheckBox6.Value = True Then Total = Total + 6
If CheckBox7.Value = True Then Total = Total + 7
If CheckBox8.Value = True Then Total = Total + 8
If CheckBox9.Value = True Then Total = Total + 9

'OK, une des 3 option est sélectionnée
If OptionButton1.Value = True Then Total = Total + 20
If OptionButton2.Value = True Then Total = Total + 10
If OptionButton3.Value = True Then Total = Total - 20
'mettre à jour la case Total
txt_Points.Caption = Format(Total, "##0.00")
End Sub

Private Sub CommandButton1_Click()
Dim Total
Total = Val(txt_Points.Caption)
'contrôle qu'un participant est sélectionné
If lst_Participants.ListIndex = -1 Then
MsgBox "Sélectionner un participant !"
Exit Sub
End If

'calcul du Total
Calculer_Total

'calcule les pénalités ( cas clic direct sur bouton OK )
If Total <> 9999 Then Calculer_Pénalités

'gestion du temps mis
Select Case txt_Temps.Text
Case "AB"
Total = 9999
Case ""
If Total <> 9999 Then
MsgBox "Préciser le temps mis ou abandon !"
txt_Temps.SetFocus
Exit Sub
End If
Case Else
If txt_Pénalités.Caption = "ELIMINE" Then
Total = 9999
Else
Total = Total - Val(txt_Pénalités.Caption)
End If
End Select

If Total <> 9999 Then
'vérifie qu'une des 3 options est sélectionnée
If OptionButton1.Value = False _
And OptionButton2.Value = False _
And OptionButton3.Value = False Then
MsgBox "Vous n'avez pas renseigné le dernier obstacle!"
Exit Sub
End If
End If

'Résultat dans la cellule
'la ligne est celle correspondant à l'index dans la liste +10
ndx = lst_Participants.ListIndex + 10
Range("G" & ndx).Select
If Total <> 9999 Then
'total des points
ActiveCell.Value = Format(txt_Points.Caption, "##0")
'temps
Range("E" & ndx).Select
With ActiveCell
.Value = Val(Str(txt_Temps.Text)) * 100
.NumberFormat = "##"" ' ""##"" '' """
End With
'Pénalités
Range("F" & ndx).Select
With ActiveCell
.Value = Val(Str(txt_Pénalités.Caption))
.NumberFormat = "[>=2]0.00"" pts"";0.00"" pt""_s"
If ActiveCell.Value = 0 Then ActiveCell = ""
End With
'Colonne H somme des points - pénalités
MaSomme = Val(Str(txt_Points.Caption)) -
Val(Str(txt_Pénalités.Caption))
Range("H" & ndx).Select
With ActiveCell
.Value = MaSomme
.NumberFormat = "[>=2]0.00"" pts"";[Red]0.00"" pt""_s"
End With
Else
Range("G" & ndx).Select
If txt_Temps.Text = "AB" Then 'abandon
ActiveCell.Value = "AB"
Else
ActiveCell.Value = "EL"
End If
'vide les cellules en E, F et H
Range("E" & ndx).Value = ""
Range("F" & ndx).Value = ""
Range("H" & ndx).Value = ""
End If
End Sub

Private Sub CommandButton2_Click()
'première cellule vide de la colonne G à partir ligne 10
Sheets("Participants").Activate
Range("G10").Select
Do While ActiveCell.Value <> "" 'boucle tant que cellule est non
vide
ActiveCell.Offset(1, 0).Select 'ligne du dessous
Loop
Hide
End Sub

Private Sub lst_Participants_Change()
'renseigner le numéro, le cavalier et le cheval
If lst_Participants.ListIndex = -1 Then
'réinitialiser les checkbox, etc
lbl_Numéro.Caption = ""
lbl_Cavalier.Caption = ""
lbl_Cheval.Caption = ""
Else
Init_Obstacles
lbl_Numéro.Caption =
lst_Participants.List(lst_Participants.ListIndex, 0)
lbl_Cavalier.Caption =
lst_Participants.List(lst_Participants.ListIndex, 2)
lbl_Cheval.Caption =
lst_Participants.List(lst_Participants.ListIndex, 1)
End If
End Sub


Private Sub TextBox1_Change()
TextBox1 = MaSomme
End Sub


Private Sub opt_Refus_0_Click()
Calculer_Total
End Sub

Private Sub opt_Refus_1_Click()
Calculer_Total
End Sub

Private Sub opt_Refus_2_Click()
Calculer_Total
End Sub

Private Sub opt_Refus_3_Click()
Calculer_Total
End Sub

Private Sub OptionButton1_Click()
Calculer_Total
End Sub

Private Sub OptionButton2_Click()
Calculer_Total
End Sub

Private Sub OptionButton3_Click()
Calculer_Total
End Sub

Private Sub txt_Temps_Change()
If UCase(txt_Temps.Text) = "A" Then txt_Temps.Text = "AB"
End Sub

Private Sub txt_Temps_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Calculer_Pénalités
End Sub

Private Sub Calculer_Pénalités()
'temps renseigné ?
If txt_Temps.Text = "" Then
MsgBox "Renseigner le temps ou abandon !"
txt_Temps.SetFocus
Exit Sub
End If

'calcul pénalités
If txt_Temps.Text = "AB" Then
txt_Pénalités.Caption = "ABANDON"
Exit Sub
End If
xAccordé = Val(Str(txt_Accordé.Caption))
xLimite = Val(Str(txt_Limite.Caption))
xTemps = Replace(txt_Temps.Value, ",", "")
xTemps = Val(Str(xTemps)) / 100

If xTemps < xAccordé Then
txt_Pénalités.Caption = 0
Exit Sub
End If

If xTemps < xLimite Then
delta = (xTemps - xAccordé) 'différence
P_Entier = Int(delta) 'partie entière
P_Décim = delta - P_Entier 'partie décimale

If P_Décim > 0 Then
xPénalités = P_Entier * 0.25 + 0.25
Else
xPénalités = P_Entier * 0.25
End If
txt_Pénalités.Caption = Format(xPénalités, "##0.00")
txt_Temps.Text = Format(xTemps, "##0.00")
Else
txt_Pénalités.Caption = "ELIMINE"
End If
End Sub

Private Sub txt_Temps_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
'gestion des touches frappées
If txt_Temps.Text = "AB" Or txt_Temps.Text = "A" Or txt_Temps.Text = "B"
Then
MsgBox "Effacer la mention avant de modifier !"
Exit Sub
End If
Select Case KeyAscii
Case 65, 97
'a ou A pour abandon
Case 48 To 57
'OK, chiffres de 0 à 9
If InStr(txt_Temps.Text, ",") > 0 Then
nbdecimale = Len(txt_Temps.Text) - InStr(txt_Temps.Text, ",")
If nbdecimale >= 2 Then
KeyAscii = Asc(Chr(8))
End If
End If
'Case 44
'If InStr(txt_Temps.Text, ",") = 0 Then
' KeyAscii = Asc(Chr(44))
'Else
' KeyAscii = Asc(Chr(8))
'End If
'Case 46
'point changé en virgule
'If InStr(txt_Temps.Text, ",") = 0 Then
' KeyAscii = Asc(Chr(44))
'Else
' KeyAscii = Asc(Chr(8))
'End If
Case Else
KeyAscii = Asc(Chr(8))
End Select
End Sub

Private Sub UserForm_Activate()
'quelle ligne a déclenché l'affichage ?
lig = ActiveCell.Row
'initialiser les contrôles checkbox obstacles franchis
Init_Obstacles
'données numéro, cavalier, cheval
lbl_Numéro.Caption = ""
lbl_Cavalier.Caption = ""
lbl_Cheval.Caption = ""
'charger la liste des participants
Liste_Participants
'affiche numéro, cavalier, cheval
lst_Participants.ListIndex = lig - 10
'temps accordé et temps limite
txt_Accordé.Caption = Format(Range("A6").Value / 100, "##0.00")
txt_Limite.Caption = Format(Range("B6").Value / 100, "##0.00")
txt_Pénalités.Caption = Format(0, "##0.00")
End Sub

Private Sub Init_Obstacles()
For i = 1 To 9
Me.Controls("Checkbox" & i).Value = True
Next i
'aucun refus par défaut
opt_Refus_0.Value = True
'dernier obstacle
OptionButton1.Value = False 'joker OK
OptionButton2.Value = False 'obstacle 10
OptionButton3.Value = False 'joker pas OK
End Sub

Private Sub Liste_Participants()
Sheets("Participants").Activate
der = Range("A500").End(xlUp).Row
If der = 10 Then
MsgBox "La liste des participants est vide !!!"
Exit Sub
End If

Range("A10").Select
lst_Participants.Clear
Do While ActiveCell.Value <> ""
lst_Participants.AddItem
ndx = lst_Participants.ListCount - 1
lst_Participants.List(ndx, 0) = ActiveCell.Value
'numéro
lst_Participants.List(ndx, 1) = ActiveCell.Offset(0, 1).Value
'cavalier
lst_Participants.List(ndx, 2) = ActiveCell.Offset(0, 2).Value
'cheval
ActiveCell.Offset(1, 0).Select
Loop
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
'éxecute la procédure du bouton Quitter
CommandButton2_Click
End Sub