XL 2019 Saisie de Résultats avec UserForm

Caninge

XLDnaute Accro
Bonjour à tous,

une météo plutôt à rester à la maison derrière l'ordinateur.
Justement j'en profite pour regarder mon fichier de tournoi de scrabble.
Il y a 7 joueurs dans ce tournoi qui doivent rencontrer les 6 autres en 4 parties.
A chaque fois je dois chercher dans le tableau les rencontres et inscrire les résultats.
Pas trop facile d'autant plus que si le tournoi s'étoffe en joueurs la recherche peut devenir fastidieuse.
J'ai pensé que je pourrais saisir les résultats à partir d'un module USERFORM.
Je clique sur le bouton bleu pour appeler la boite de saisie.
Un coup arrivé sur cette boite je cherche les deux joueurs et je note les résultats.
J'ai créé un USERFORM dans la feuille des codes.
Par contre je m'arrête là parce que la suite je ne sais pas faire.

Mais vous oui !

Merci de se pencher sur mon projet.

CANINGE
 

Pièces jointes

  • Tournoi de Scrabble à 7 joueurs à Avermes.xlsm
    45.3 KB · Affichages: 9

Caninge

XLDnaute Accro
justement j'envoie le fichier parce qu'il ne fonctionne pas.
je me mélange tout. C'est compliqué.
Voila les lignes du code.
Dim flag As Boolean
Option Explicit


Private Sub UserForm_Initialize()
Dim i As Byte
i = 4
While Range("Z" & i) <> vbNullString 'boucle depuis Z4 et tant que Zx n'est pas vide
ComboBox1.AddItem Range("Z" & i).Value
ComboBox2.AddItem Range("Z" & i).Value
i = i + 1
Wend
End Sub
Private Sub ComboBox1_Change()
If ComboBox1.Value = ComboBox2.Value Then
MsgBox "Vous ne pouvez avoir deux joueurs identiques !", vbInformation, "Erreur choix joueur": ComboBox1 = vbNullString: Exit Sub
End If
End Sub

Private Sub ComboBox2_Change()
If ComboBox2.Value = ComboBox1.Value Then
MsgBox "Vous ne pouvez avoir deux joueurs identiques !", vbInformation, "Erreur choix joueur": ComboBox2 = vbNullString: Exit Sub
End If
End Sub
Private Sub CommandButton1_Click()
Dim i As Integer
Dim j As Boolean

Call controle

If flag = True Then Exit Sub

For i = 5 To Range("B" & Rows.Count).End(xlUp).Row
If Range("B" & i) = ComboBox1.Value And Range("N" & i) = ComboBox2.Value Then
If Range("C" & i) = vbNullString And Range("O" & i) = vbNullString Then
Range("C" & i) = TextBox1.Value
Range("O" & i) = TextBox2.Value
MsgBox "Socres ajoutés", vbInformation, "Scores rencontre": j = 1: Exit For
End If
End If
Next i
If j = 0 Then MsgBox "Rencontres déjà terminées. Pas de scores ajoutés", vbInformation, "Scores rencontre" '

Call effacer

End Sub
Private Sub controle()
Dim c As Control

For Each c In Me.Controls
If TypeName(c) <> "Label" Then
Select Case TypeName(c)
Case "TextBox"
If c.Value = vbNullString Then MsgBox "veuillez compléter la rubrique " & c.Tag, , "Rubrique incomplète": flag = True: Exit Sub
Case "ComboBox"
If c.Value = vbNullString Then MsgBox "veuillez compléter la rubrique " & "Combobox " & c.Tag, , "Rubrique incomplète": flag = True: Exit Sub
End Select
End If
Next c
flag = False
End Sub
Private Sub effacer()
ComboBox1 = vbNullString
ComboBox2 = vbNullString
TextBox1 = vbNullString
TextBox2 = vbNullString
End
SubPrivate
Sub Envoyer_Click()

End Sub
 

Dan

XLDnaute Barbatruc
Mais je vous ai écrit les erreurs....
Dans mon post précédent point 4, le code est comme ceci

VB:
Private Sub effacer()
ComboBox1 = vbNullString
ComboBox2 = vbNullString
TextBox1 = vbNullString
TextBox2 = vbNullString
End Sub
et pas comme ce que vous mettez

Code:
Private Sub effacer()
ComboBox1 = vbNullString
ComboBox2 = vbNullString
TextBox1 = vbNullString
TextBox2 = vbNullString
End
SubPrivate
Sub Envoyer_Click()

End Sub
Le reste est bon
 

Caninge

XLDnaute Accro
Je viens de modifier
j'appuie sur CommandButton1 et je n'ai pas les résultats

Dim flag As Boolean
Option Explicit


Private Sub UserForm_Initialize()
Dim i As Byte
i = 4
While Range("Z" & i) <> vbNullString 'boucle depuis Z4 et tant que Zx n'est pas vide
ComboBox1.AddItem Range("Z" & i).Value
ComboBox2.AddItem Range("Z" & i).Value
i = i + 1
Wend
End Sub
Private Sub ComboBox1_Change()
If ComboBox1.Value = ComboBox2.Value Then
MsgBox "Vous ne pouvez avoir deux joueurs identiques !", vbInformation, "Erreur choix joueur": ComboBox1 = vbNullString: Exit Sub
End If
End Sub

Private Sub ComboBox2_Change()
If ComboBox2.Value = ComboBox1.Value Then
MsgBox "Vous ne pouvez avoir deux joueurs identiques !", vbInformation, "Erreur choix joueur": ComboBox2 = vbNullString: Exit Sub
End If
End Sub
Private Sub CommandButton1_Click()
Dim i As Integer
Dim j As Boolean

Call controle

If flag = True Then Exit Sub

For i = 5 To Range("B" & Rows.Count).End(xlUp).Row
If Range("B" & i) = ComboBox1.Value And Range("N" & i) = ComboBox2.Value Then
If Range("C" & i) = vbNullString And Range("O" & i) = vbNullString Then
Range("C" & i) = TextBox1.Value
Range("O" & i) = TextBox2.Value
MsgBox "Socres ajoutés", vbInformation, "Scores rencontre": j = 1: Exit For
End If
End If
Next i
If j = 0 Then MsgBox "Rencontres déjà terminées. Pas de scores ajoutés", vbInformation, "Scores rencontre" '

Call effacer

End Sub
Private Sub controle()
Dim c As Control

For Each c In Me.Controls
If TypeName(c) <> "Label" Then
Select Case TypeName(c)
Case "TextBox"
If c.Value = vbNullString Then MsgBox "veuillez compléter la rubrique " & c.Tag, , "Rubrique incomplète": flag = True: Exit Sub
Case "ComboBox"
If c.Value = vbNullString Then MsgBox "veuillez compléter la rubrique " & "Combobox " & c.Tag, , "Rubrique incomplète": flag = True: Exit Sub
End Select
End If
Next c
flag = False
End Sub
Private Sub effacer()
ComboBox1 = vbNullString
ComboBox2 = vbNullString
TextBox1 = vbNullString
TextBox2 = vbNullString
End Sub
 

Dan

XLDnaute Barbatruc
Sans lancer le code depuis le bouton bleu allez sur l'userform faites double clic sur le bouton
Cela doit vous amener au code Private Sub CommandButton1_Click()
Si ce n'est pas le cas vous avez modifié quelque chose


EDIT : en regardant votre dernier fichier posté, pourquoi êtes-vous allé changer le nom du bouton ???

Presse-papier02.jpg

Re Edit : Si vous voulez changer le nom de votre bouton sur votre Userform, vous pouvez le faire en changeant dans la propriété CAPTION qui se trouve un peu plus bas dans la vue. C'est peut être cela que vous vouliez faire ?
 
Dernière édition:

Caninge

XLDnaute Accro
Bonjour Dan,
oui effectivement j'ai voulu essayé de changer le nom du bouton. Mais pas au bon endroit.
Je suis allé sur CAPTION et j'ai modifié.
Apparemment ca marche. Je vous tiens au courant en cas !
Merci beaucoup pour votre aide et votre patience.
CANINGE
 

Discussions similaires

Statistiques des forums

Discussions
313 205
Messages
2 096 209
Membres
106 530
dernier inscrit
miomi98