Re : Texte userform
Bonjour le forum
Bonjour Pierrot
Vu la lourdeur du fichier je te joins mon userform complet avec ta modif.
Il y a tableau Userform1
informations : Le dernier tirage: et je saisis le tirage du: le code lit les dates.
second tableau Numeros et 5 cases pour les recevoir + N) chance et sa case
2 boutons Valider: 'code au début et Annuler: pour entrer dans le fichier sans mise à jour de date.
Userform1
Private Sub UserForm_Initialize()
'Ta modife
Dim d As Date
d = Sheets("Loto2").Range("A65536").End(xlUp).Value
Tb1.Text = d
Tb2.Text = IIf(Weekday(d, 2) = 3, d + 3, d + 2)
Frame1.Caption = "Tirage du " & Tb2.Text
End Sub
Private Sub CommandButton1_Click()
'Dévalide le calcule automatique
Application.Calculation = xlManual
'Vérifie si les numéros saisis et inférieurs à 49 ou 10
If N1 = "" Or N1 > 49 Then
Validation.Caption = "Case 1 : numéro invalide"
Else
Validation.Caption = ""
If N2 = "" Or N2 > 49 Then
Validation.Caption = "Case 2 : numéro invalide"
Else
Validation.Caption = ""
If N3 = "" Or N3 > 49 Then
Validation.Caption = "Case 3 : numéro invalide"
Else
Validation.Caption = ""
If N4 = "" Or N4 > 49 Then
Validation.Caption = "Case 4 : numéro invalide"
Else
Validation.Caption = ""
If N5 = "" Or N5 > 49 Then
Validation.Caption = "Case 5 : numéro invalide"
Else
Validation.Caption = ""
If E1 = "" Or E1 > 10 Then
Validation.Caption = "Chance 1 : numéro invalide"
Else
Validation.Caption = ""
End If
End If
End If
End If
End If
End If
If Validation.Caption <> "" Then
'MsgBox ("Erreur de saisie")
'Remplissage
Else
Dim LValue As String
LValue = Format(Tb2.Text, "yyyy/mm/dd")
ActiveCell.Value = LValue
ActiveCell.Offset(0, (N1.Value)) = N1.Value
ActiveCell.Offset(0, (N2.Value)) = N2.Value
ActiveCell.Offset(0, (N3.Value)) = N3.Value
ActiveCell.Offset(0, (N4.Value)) = N4.Value
ActiveCell.Offset(0, (N5.Value)) = N5.Value
ActiveCell.Offset(0, (E1.Value + 50)) = E1.Value
ActiveCell.Offset(0, 61) = LValue
'Mise à jour des tableaux
'tableau BK-DR
i = 62
Do Until i = 122
ActiveCell.Offset(0, (i)).FormulaR1C1 = "=IF(ISBLANK(RC1),"""",IF(ISBLANK(RC[-61]),1+N(R[-1]C),0))"
i = i + 1
Loop
ActiveCell.Offset(0, 122).FormulaR1C1 = "=SUM(RC[-121]:RC[-72])"
'tableau DU-GB
ActiveCell.Offset(0, 123).Value = ActiveCell.Offset(-1, 123).Value + 1
j = 124
Do Until j = 184
ActiveCell.Offset(0, (j)).FormulaR1C1 = "=IF((RC[-62]=0),N(R[-1]C[-62]),"""")"
j = j + 1
Loop
'Valide le calcul automatique et calcul
Application.Calculation = xlAutomatic
Calculate
'Préparation pour tableaux feuille Etude de pas
ActiveCell.Offset(0, 124).Select
Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(0, 49)).Select
Selection.Copy
'Mise à jour tableau
Sheets("Etude des Pas L").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Selection.Copy
Application.CutCopyMode = False
ActiveWorkbook.Worksheets("Etude des Pas L").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Etude des Pas L").Sort.SortFields.Add Key:=Range( _
"A1:AX1"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Etude des Pas L").Sort
.SetRange Range("A1:AX1")
.Header = xlGuess
.MatchCase = False
.Orientation = xlLeftToRight
.SortMethod = xlPinYin
.Apply
End With
Selection.Copy
Range("AT1:AX1").Select
Application.CutCopyMode = False
Selection.Copy
Application.CutCopyMode = False
Selection.Cut
Application.CutCopyMode = False
Selection.Copy
Selection.Copy
Range("A7").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 1).Select
ActiveSheet.Paste
ActiveCell.Offset(0, -1).Value = LValue
Rows("1:1").Select
Selection.ClearContents
Range("A7").Select
Selection.End(xlDown).Select
End
UserForm1.Hide
End If
End Sub
Private Sub CommandButton2_Click()
End
UserForm1.Hide
Application.Calculation = xlAutomatic
Calculate
End Sub
ça va la 1ere mise à jour ensuite il met la date en DU
et je ne comprends rien.
Merci de ton aide et de ta patience.
Vois si tu peux faire quelque chose et merci d'avance.
a+
wmichelange
