bjr dranreb quant je lance ton programme pour 36 participant 5 tour il me donne erreur donc voici le tableau
ci cela peut d'aider a comprendre merci
ption Explicit
Private Declare PtrSafe Function QueryPerformanceFrequency Lib "Kernel32" (X As Currency) As Boolean
Private Declare PtrSafe Function QueryPerformanceCounter Lib "Kernel32" (X As Currency) As Boolean
Private Declare PtrSafe Function MessageBeep Lib "user32.dll" (ByVal wType As Long) As Long
Private TopDépart As Currency, Top As Currency, TopRaff As Currency, DTop1sec As Currency, DTop40ms As Currency
Private SMin As Double, SMax As Double, Phase As Long, TpSec As Long, _
WithEvents Décharger As Planification, Terminé As Boolean
Rem. ——— Propriété et méthodes utilisées par les processus de tirage.
Public Abandon As Boolean
Public Sub DescConfig(ByVal Texte As String)
Décharger.Annuler
LabInf3.Caption = "Config.: " & Texte _
& vbLf & "Si d'ordinaire c'est rapide, abandonnez," _
& vbLf & "puis réessayez, plusieurs fois au besoin."
LabFait.Caption = "": LabTout.Caption = ""
LabTemps.Visible = False
Abandon = False: Terminé = False
SMin = 0: SMax = 0: Visu 0: SMin = 1
Me.Caption = "Tirage en cours…"
Me.Height = 54: Label1.Width = 0: Phase = 1: Me.Show
QueryPerformanceFrequency DTop1sec: DTop40ms = DTop1sec * 40 / 1000
QueryPerformanceCounter TopDépart
TopRaff = TopDépart + DTop40ms
End Sub
Public Sub Montre(ByVal S As Double)
If SMin > S Then SMin = S
If SMax < S Then SMax = S
QueryPerformanceCounter Top
If Top < TopRaff Then Exit Sub
Visu S
Dim T As Double: T = (Top - TopDépart) / DTop1sec
On Phase GoSub 1, 2, 3, 4, 5, 6
DoEvents
SMin = 1: SMax = 0
TopRaff = TopRaff + DTop40ms: Exit Sub
Dim CV As Double, H As Double
1: If T < 10 Then Return Else Phase = 2
2: If T < 12 Then H = IntpoCyc(T, 10, 54, 12, 108): GoTo RévH Else H = 108: GoSub RévH: Phase = 3
3: If T < 16 Then Label1.Width = IntpoCyc(T, 12, 0, 16, 180): Return Else Label1.Width = 180: Phase = 4
4: If T < 60 Then Return Else Phase = 5
5: If T < 64 Then H = IntpoCyc(T, 60, 108, 64, 351): GoTo RévH
H = 351: GoSub RévH: Phase = 6: LabTemps.Visible = True: TpSec = Int(T)
6: If T < TpSec Then Return
LabTemps.Caption = Int(T / 86400) & " jours " & Format(T / 86400, "hh:mm:ss")
TpSec = Int(TpSec) + 1: Return
RévH: CV = Me.Top + Me.Height / 2: Me.Height = H: Me.Top = CV - Me.Height / 2: Return
End Sub
Public Sub Conclure()
Dim T As Double, S() As String, M As Double, E As Long
QueryPerformanceCounter Top
T = (Top - TopDépart) / DTop1sec
SMin = 1: SMax = 1: Visu 1: Me.Height = 54: Me.Caption = "Tirage réussi."
Select Case T
Case Is < 10: S = Split(Format(T, "000.E+00"), "E"): E = S(1) \ 3: M = S(0) * 10 ^ S(1) * 1000 ^ -E
LabFait.Caption = Choose(1 - E, "Dénoué", "Réglé", "Aperçu") & " en " _
& M & " " & Choose(1 - E, "", "milli", "micro") & "seconde" & IIf(M > 1, "s", "") & "."
Case Is < 60: LabFait.Caption = "Dépêtré en " & Format(T, "0.0") & " seconde" & "."
Case Else: LabFait.Caption = "Achevé en " & DuréeEnClairSec(T) & "."
End Select
Terminé = True: MessageBeep vbInformation: Décharger.PlanifierDans 5
End Sub
Public Sub Echec(Optional ByVal Texte As String = "Aucune solution trouvée.")
Dim T As Double, S() As String, M As Double, E As Long
SMin = 0: SMax = 0: Visu 0: Me.Height = 54: Me.Caption = "Tirage raté."
Terminé = True: MessageBeep vbCritical: Décharger.PlanifierDans 3
LabTout.Caption = IIf(Abandon, "Procédure abandonnée.", Texte)
End Sub
Rem. ——— Fin des méthodes utilisables par le processus de tirage.
Private Sub UserForm_Initialize()
Set Décharger = New Planification
End Sub
Private Function IntpoCyc(ByVal T As Double, ByVal T0 As Double, ByVal V0 As Double, _
ByVal T1 As Double, ByVal V1 As Double) As Double
IntpoCyc = V0 + (V1 - V0) * Cyclo((T - T0) / (T1 - T0))
End Function
Private Function Cyclo(ByVal X As Double) As Double
Const Pi = 245850922 / 78256779, Pi×2 = 2 * Pi
Cyclo = X - Sin(X * Pi×2) / Pi×2
End Function
Private Function DuréeEnClairSec(ByVal DuRest As Double) As String
Dim U As Long, DuUnit As Double, NbUnit As Long, Niv As Long, Trad As String
For U = 1 To 7
DuUnit = Choose(U, 31556952, 2629746, 604800, 86400, 3600, 60, 1)
NbUnit = Int(DuRest / DuUnit)
If NbUnit > 0 Or Niv > 0 Then Niv = Niv + 1: If Niv > 2 Then Exit Function
If NbUnit > 0 Then
Trad = NbUnit & " " & Choose(U, "an", "mois", "semaine", "jour", "heure", "minute", "seconde")
If NbUnit * Choose(U, 1, 0, 1, 1, 1, 1, 1) > 1 Then Trad = Trad & "s"
If Niv = 2 Then DuréeEnClairSec = DuréeEnClairSec & " et "
DuréeEnClairSec = DuréeEnClairSec & Trad: End If
DuRest = DuRest - DuUnit * NbUnit: Next U
End Function
Private Sub Visu(ByVal S As Double)
