Aide sur userform à répéter

[doclefou]

Bonsoir à tous,
Je suis en train de monter un fichier sur la NBA pour une sélection d'une équipe "Dream Team".

Pour cela, je veux utiliser un formulaire (usf) de saisie. Cet usf contient plusieurs zones et plusieurs listes pour définir les caractéristiques des membres (joueurs) de cette équipe. J'enregistre joueur par joueur dans une nouvelle feuille que je nomme en fonction du choix du nom de l'equipe.

Je cherche donc à répéter l'opération jusqu'à ce que l'équipe soit complète avec 12 joueurs. C'est là mon problème, je ne sais pas comment faire. Je suppose que c'est en passant par une boucle.

L'enregistrement du joueur se passe par un bouton "Enregistrer le joueur".

1) Comment puis-je faire pour enregistrer chaque joueur à chaque clic ?
2) Le nombre de joueurs restants doit baisser de 12 à 0. Une fois que le premier joueur est enregistré, le choix de l'équipe est faite. Il faudrait donc qu'ensuite ce nom reste et qu'il ne soit plus modifié.
3) Le bouton "Enregistrer l'équipe" doit être actif à 0 joueur restant mais pas avant et inversement, le bouton "Enregistrer le joueur" ne doit plus l'être (actif).

Dans mon fichier, il y a une feuille nommée GRIZZLIES pour montrer le résultat attendu à la fin de la saisie

J'en demande peut-être trop mais je pêche dessus depuis plusieurs jours.

Merci d'avance à tous ceux qui se pencheront sur mon cas. N'hésitez à me poser vos questions si je ne suis pas assez clair et s'il y une autre façon de faire, je suis ouvert à toutes proposition.

Cordialement,

Doc le Fou

 

[mapomme]

Re : Aide sur userform à répéter

Bonsoir doclefou,

J'ai modifié un peu la logique du formulaire.

Un onglet d'équipe est créé quand on change d'équipe dans le formulaire par le biais de l'évènement liste_equipe_Change.
C'est dans cet évènement qu'on gère aussi le nombre de joueurs déjà créés ainsi que que l'activation des boutons bouton_enregistrer et bouton_terminer.

On n'est pas obligé de saisir les 12 joueurs d'une équipe en une seule fois. On peut choisir une équipe, saisir un joueur puis passer à une autre équipe, saisir un joueur pour cette seconde équipe puis revenir ensuite à la première équipe et continuer la saisie des joueurs.

Avant d'enregistrer un joueur, il faudrait s'assurer que les champs obligatoires sont tous renseignés.

Edit : version 2 avec vérification de la complétude de tous les champs d'un joueur (utilisation de la propriété TAG pour les champ à saisir) et correction de la colonne qui sert à déterminer le nombre de joueur déjà saisis. (comme il y a des cellules fusionnées en colonne A, on ne peut pas utiliser cette colonne facilement pour déterminer le nombre de joueurs saisis)

 

[doclefou]

Re : Aide sur userform à répéter

Bonsoir à tous,

Merci MAPOMME pour ta solution. Je viens de tester ta solution qui fonctionne à merveille.
J'ai apporté quelques corrections à ce que j'avais fait puisque des erreurs se sont glissées dans mes listes.

J'ai rajouté le code suivant pour que le bouton "Enregistrer l'équipe" soit opérationnel :
Private Sub bouton_terminer_Click() 'Enregistre l'équipe
MsgBox "L'équipe " & ActiveSheet.Name & " a été créé"
Unload Me

End Sub

Merci donc à toi.

Puis-je me permettre de te demander ou aux autres forumeurs, comment mettre les différentes couleurs en fonction du poste du joueur ?
Si le poste est meneur, alors les celulles B à S sont en vert, et ainsi de suite comme sur la feuille "GRIZZLIES"

Donne soirée à tous

DOC LE FOU

 

[mapomme]

Re : Aide sur userform à répéter

Bonjour,

Mettre le code suivant dans le module1 puis exécuter Formater_Equipe(). L'ordre des joueurs ainsi que la couleur des fonds sont ceux de la liste des postes de la feuille 'base'.

Sub Formater_Equipe()
Dim Postes(1 To 5), CouleursFond(1 To 5)
Dim i, j, K
Dim xSh As Worksheet, NbJoueurs

'lecture des postes et de leur couleur de fond
For i = 1 To 5
    Postes(i) = Sheets("base").Cells(1 + i, 3)
    CouleursFond(i) = Sheets("base").Cells(1 + i, 3).Interior.Color
Next i

'boucle sur les feuilles d'équipe
For Each xSh In Worksheets
    If Not (xSh.Name = "divisions_conférences" Or xSh.Name = "base" Or _
        xSh.Name = "vierge") Then
        With xSh
            xSh.Activate
            NbJoueurs = .Range("D65536").End(xlUp).Row - 1
            'boucle pour remplacer le libellé du poste par le rang du poste
            For i = 2 To NbJoueurs + 1
                For j = 1 To 5
                    If .Cells(i, 3) = Postes(j) Then
                        .Cells(i, 3) = j
                        Exit For
                    End If
                Next j
            Next i
            'tri du tableau
            .Range("B1:S" & NbJoueurs + 1).Sort key1:=.Range("C1"), Order1:=xlAscending, _
                key2:=.Range("B1"), Order2:=xlAscending, key3:=.Range("D1"), Order3:=xlAscending, _
                Header:=xlYes
            'boucle pour remplacer rang du poste par le libellé du poste
            'et colorer le fond
            For i = 2 To NbJoueurs + 1
                .Range("B" & i & ":S" & i).Interior.Color = CouleursFond(.Cells(i, 3))
                .Cells(i, 3) = Postes(.Cells(i, 3))
            Next i
        End With
    End If
Next xSh
End Sub

 

[doclefou]

Re : Aide sur userform à répéter

Bonjour MAPOMME,

Merci pour le code.

Je l'ai copié comme tu me l'indique dans Module1, j'ai ensuite lancé la macro mais j'ai une erreur :
Erreur d'exécution '13' :
Incompatibilité de type
Sur la ligne .Range("B" & i & ":S" & i).Interior.Color = CouleursFond(.Cells(i, 3)).

J'ai réglé mon problème !!! Mais comme ce matin, je ne suis pas bien réveillé, je n'ai pas pris le temps de bien regarder le code que tu m'as donné.
En faite, le problème venait de ce bout là :
'lecture des postes et de leur couleur de fond
For i = 1 To 5
Postes(i) = Sheets("base").Cells(1 + i, 3)
CouleursFond(i) = Sheets("base").Cells(1 + i, 3).Interior.Color
Next i

Hier, en testant ce que tu m'avais déjà donné, j'ai été obligé de changer ma liste de POSTE. Du coup, le "3" n'est plus bon. Pour régler le problème, je l'ai remplacé par "4", ce qui donne ceci :
'lecture des postes et de leur couleur de fond
For i = 1 To 5
Postes(i) = Sheets("base").Cells(1 + i, 4)
CouleursFond(i) = Sheets("base").Cells(1 + i, 4).Interior.Color
Next i

Merci beaucoup à toi pour le temps passé sur mon cas.

 

[doclefou]

Re : Aide sur userform à répéter

Bonjour à tous,

Je reviens sur ce sujet car je me suis aperçu d'un petit souci.
Lors de la sélection de l'équipe pour la création d'une équipe via le menu déroulant appelé "liste_equipe", si on clique sur la flèche de la listbox pour choisir l'équipe voulue, une feuille est créée avec le nom. Ca c'est le résultat escompté. Mais si on descend avec les flèches, cela créé autant de feuilles. Par exemple, je descends avec la flèche du bas jusqu'à la 3° équipe, alors j'ai 3 feuilles de créées dont 2 que je ne veux pas.

Y a t-il un moyen d'empêcher cela ? Ou alors que la feuille soit vraiment créée quand on enregistre un joueur ?

Merci de votre aide

Doclefou

 

[mapomme]

Re : Aide sur userform à répéter

Bonjour doclefou,

Pouvez-vous nous communiquer la dernière version de votre fichier ?

Merci.

 

[doclefou]

Re : Aide sur userform à répéter

Bonsoir mapomme,

Voici la version de mon fichier.

Merci

 

[mapomme]

Re : Aide sur userform à répéter

Bonsoir doclefou,

Un peu de mal à m'y replonger! J'ai donc collé une rustine dans le code.

Dans 'Private Sub liste_equipe_Change()' j'ai mis en commentaire la partie création de la feuille équipe et défini l'état des boutons.
On quitte la procédure si la feuille n'existe pas.

    On Error Resume Next
    Worksheets(liste_equipe.Text).Activate
    If Error <> "" Then
'        ==>Sheets("vierge").Copy after:=ThisWorkbook.Sheets(Sheets.Count)
'        ==> ActiveSheet.Name = liste_equipe
        bouton_enregistrer.Enabled = True
        bouton_terminer.Enabled = False
        zone_nbjoueurs_restants = 12
        Exit Sub
    End If
    On Error GoTo 0

Dans 'Private Sub Bouton_Enregistrer_Click()' je procède à la création de la feuille si elle n'existe pas.

    ' vérification si la feuille de l'équipe a déjà été créee
    ' si elle n'a pas encore été créée alors on la crée.
    On Error Resume Next
    Worksheets(liste_equipe.Text).Activate
    If Error <> "" Then
        Sheets("vierge").Copy after:=ThisWorkbook.Sheets(Sheets.Count)
        ActiveSheet.Name = liste_equipe
    End If
    On Error GoTo 0

Voyez-vous une amélioration ?

PS: Le fichier .xls ne veut pas passer car trop gros (>736 ko) - je vous joint donc un fichier texte zipé contenant le code de la UserForm 'Form_Select_Team'

 

[doclefou]

Re : Aide sur userform à répéter

Bonsoir à tous,

Un grand merci à MAPOMME. J'ai testé le nouveau code et cela fonctionne.

Merci une fois de plus pour tes compétences et le temps passé dessus.