XL 2019 VBA newbie

[apocalypse]

Bonjour,

J'essaie de mettre en place une gestion d'équipe pour le club auquel j'appartiens à travers un fichier excel.
N'étant pas un grand utilisateur d'Excel je découvre peu à peu ses fonctionnalités donc j'espère que vous serez indulgent avec moi 😉.

Je vous explique rapidement ce que j'ai fait et souhaite faire:
- la feuille Liste des joueurs contient les joueurs du club que je peux ajouter dans des équipes
- la feuille Gestion permet d'ajouter les joueurs dans des équipes, à travers cette feuille je veux aussi montrer à l'utilisateur si il peut ou non ajouter certains joueurs dans certaines équipes
- la feuille Param permet de mettre en place des paramètres (nombre de joueur par équipes, nombre de joueurs qui sont en dehors de l'UE par équipes...)
- la feuille Règles permet de mettre en place certaines règles qui permettent ou non d'ajouter des joueurs dans l'équipe

Actuellement dans la feuille Gestion j'ai "réussi" à mettre en place la règle "nombre de joueur par équipes" à travers des cellules qui passent au vert quand le nombre de joueurs dans l'équipe est correct.
Je dis réussi car comme vous pouvez le voir dans un autre post et dans la feuille que je partage j'ai bidouillé car la formule ne semble pas fonctionner dans la mise en forme des cellules sans passer par une cellule intermédiaire.

Maintenant je que je vous ai expliqué mon besoin voici mon problème : je pensais que je pourrais faire tous mes tests via des formules Excel mais force est de constater que cela s'avère plus compliqué qu'attendu, et je pense que je vais devoir faire un peu de VBA.

Autant pour les tests numérotés 1 et 5 cela me paraît simple sans passer par du VBA, autant pour les tests 2-3-4 cela me semble impossible ou alors très compliqué.
Pour le moment je m'attaque au test numéro 2 mais si vous avez des indications pour les autres tests je suis preneur.
Donc pour le test numéro 2 "Test du nombre de joueurs hors EU dans l'équipe" je voyais cela comme cela :
- récupérer la liste des licences des joueurs qui sont sélectionnés, puis vérifier si ces joueurs sont hors EU

Malheureusement mes compétences en VBA sont quasi nulles, comme vous pouvez le voir dans les macro j'ai essayé de faire une macro pour parcourir toutes les checkbox de la feuille active mais cela ne fonctionne pas : le code ne rentre jamais dans la boucle For...

Sub ListerCheckboxClicked()

    Dim obj As OLEObject
    Response = MsgBox("test", vbOK, "MsgBox Demonstration", "DEMO.HLP", 1000)
    
    For Each obj In ActiveSheet.OLEObjects
        Response = MsgBox(obj.Name + " " + obj.Index, vbOK, "MsgBox Demonstration", "DEMO.HLP", 1000)
        If TypeOf obj.Object Is msforms.CheckBox Then
            Response = MsgBox(obj.Name + " " + obj.Index, vbOK, "MsgBox Demonstration", "DEMO.HLP", 1000)
            obj.Object.Caption = "test"
        End If
    Next obj
    
End Sub

De plus si je dois faire du VBA pour un test autant tout tester en VBA, qu'en pensez-vous ?

 

[apocalypse]

Bonjour apocalypse, le forum,

En effet il faut corriger le 4ème test comme suit :

        '---4ème test sur le brûlage (cas d'un joueur ayant joué 2 fois dans une équipe supérieure)---
        Set plage1 = .Cells(-2, 4).Resize(, col - 3) 'ligne des équipes
        Set plage2 = .Cells(lig, 4).Resize(, col - 3)
        If Application.CountIf(plage2, rep) > 1 Then
            For i = 1 To plage2.Count
                If plage2(i) = rep Then ReDim Preserve a(n): a(n) = plage1(i): n = n + 1
            Next i
            i = Application.Small(a, 2) 'PETITE.VALEUR
            If equipe > i Then
                ac.Interior.Color = RGB(121, 15, 2) 'colore en rouge
                MsgBox joueur + " doit être au moins dans l'équipe " & i & "...": GoTo 1
            End If
        End If

Avec déclaration des nouvelles variables n et a().

A+

Incroyable 😅.

Merci @job75 ❤️

 

[apocalypse]

Hello,

J'ai un point de détail que j'aimerai mettre en place mais avec la solution apportée par @job75 je ne vois pas comment l'intégrer.
Dans les feuilles des équipes comme vous pouvez le voir on sauvegarde les informations que j'ai saisi dans les colonnes de G à M.
Cependant la mise en forme n'est pas sauvegardé.

Du coup quand je mets une partie du texte de la cellule d'une couleur, quand je reviens sur la feuille cela a disparu

Comme dans le code on ne garde que les informations je ne sais pas si je peux tricher en mettant directement le code couleur dans le code VBA car la règle est assez simple.

"x perf" => vert gras
"x contre" => rouge gras

Ou alors dois-je revois le code pour sauvegarder le style aussi ?

Quel est votre avis ?

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim rep$, d As Object, col%, lig&, categorie$, x$, tablo, i As Variant, j%
If Not Sh.Name Like "?quipe*#" Then Exit Sub
rep = "ü" 'caractère Wingdings pour la coche
Set d = CreateObject("Scripting.Dictionary")
With [Tableau8] 'tableau structuré de la feuille "Gestion"
    For col = 4 To .Columns.Count
        If .Cells(-2, col) = Val(Right(Sh.Name, 1)) Then
            For lig = 1 To .Rows.Count
                If .Cells(lig, col) = rep Then
                    categorie = Application.VLookup(.Cells(lig, 1), [Tableau1].Columns(3).Resize(, 2), 2, 0)
                    x = .Cells(lig, 2) & Chr(1) & .Cells(lig, 1) & Chr(1) & categorie & Chr(1) & .Cells(lig, 3)
                    d(x) = x
                End If
            Next lig
        End If
    Next col
End With
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With Sh.ListObjects(1).Range
    tablo = .Value 'mémorise
    If Not .ListObject.DataBodyRange Is Nothing Then .ListObject.DataBodyRange.Delete xlUp 'RAZ
    If d.Count Then
        With .Cells(2, 1).Resize(d.Count)
            .Value = Application.Transpose(d.items)
            .TextToColumns .Cells, Other:=True, OtherChar:=Chr(1) 'commande Convertir
        End With
    End If
    .Sort .Columns(4), xlDescending, Header:=xlYes 'tri sur les points officiels
End With
'---récupère les données mémorisées des colonnes G:M---
With Sh.ListObjects(1).Range
    For lig = 2 To .Rows.Count
        i = Application.Match(.Cells(lig, 2), Application.index(tablo, , 2), 0)
        If IsNumeric(i) Then
            For col = 6 To 12
                .Cells(lig, col) = tablo(i, col)
                '.Cells(lig, col).Style = tablo(i, col).Style
            Next col
        End If
    Next lig
End With
End Sub

 

[TooFatBoy]

Comme dans le code on ne garde que les informations je ne sais pas si je peux tricher en mettant directement le code couleur dans le code VBA car la règle est assez simple.

"x perf" => vert gras
"x contre" => rouge gras

J'ai bien peur qu'il faille une solution un peu plus complexe, comme par exemple une macro pour colorier les parties de texte qui doivent l'être.

 

[job75]

Bonjour le forum,

A vouloir surcharger les feuilles (souvent inutilement) on va vers des usines à gaz.

A+

 

[job75]

Si vous tenez vraiment à colorier les textes mettez dans ThisWorkbook :

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Not Sh.Name Like "?quipe*#" Then Exit Sub
Set Target = Intersect(Target, Sh.[G:M])
If Target Is Nothing Then Exit Sub
Dim p%
For Each Target In Target
    p = InStr(Target, "-")
    If p Then
        If Target Like "*- *contre" Then
            With Target.Characters(p + 1, 9).Font
                .Bold = True
                .Color = vbRed 'rouge
            End With
        ElseIf Target Like "*- *perf" Then
            With Target.Characters(p + 1, 9).Font
                .Bold = True
                .Color = RGB(0, 176, 80) 'vert foncé
            End With
        End If
    End If
Next
End Sub

 

[apocalypse]

Si vous tenez vraiment à colorier les textes mettez dans ThisWorkbook :

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Not Sh.Name Like "?quipe*#" Then Exit Sub
Set Target = Intersect(Target, Sh.[G:M])
If Target Is Nothing Then Exit Sub
Dim p%
For Each Target In Target
    p = InStr(Target, "-")
    If p Then
        If Target Like "*- *contre" Then
            With Target.Characters(p + 1, 9).Font
                .Bold = True
                .Color = vbRed 'rouge
            End With
        ElseIf Target Like "*- *perf" Then
            With Target.Characters(p + 1, 9).Font
                .Bold = True
                .Color = RGB(0, 176, 80) 'vert foncé
            End With
        End If
    End If
Next
End Sub

Merci, j'avais fait quelque chose à base de plus moche et je suis resté sur le non changement de couleur du texte.
Comme vous le disiez ça surcharge pour pas grand chose car le rendu final n'était pas top en plus.