Recherche code vba pour MFC

Version imprimable

20/04/2014, 17h30
jacfld49

1 pièce(s) jointe(s)

Recherche code vba pour MFC

Bonjour le forum,

Dans le tableau du fichier joint, je fais le classement par ordre d'arrivé
je cherche le code VBA pour faire une MFC qui me colorie la ligne ou le plus jeune des participants serait le mieux classé en tenant compte que les plus jeune sont des juniors et qu'ils sont nés entre 1995 et 1996, comme indiqué dans la feuille cate que j'ai surligné en jaune car dans mon tableau, j'ai que les dates de naissances qui me servent à trouver le plus jeune
j'ai colorié la ligne manuellement dans le fichier joint du plus jeune
merci d'avance
Jacky
20/04/2014, 19h33
Invité

Bonjour,

Une solution possible sans MFC.

J'ai ajouté une colonne catégorie dans la feuille Epreuve. J'ai remplacé Avant par 1800 dans la feuille CATE.

Le fichier contient une fonction permettant d'indiquer la catégorie suivant l'âge du participant et une procédure pour déterminer le premier de chaque catégorie.
Les couleurs sont déterminées selon les colonnes F et H dans la feuille CATE.

Cordialement.
20/04/2014, 20h47
jacfld49

Bonsoir le forum, Eric,

merci beaucoup, cela fonctionne, il va falloir que je change mes autres codes car l'ajout de la colonne change mes autres code mais c'est parfait
jacky

Bonjour,

Pour ne faire apparaître uniquement que le premier de la catégorie la plus jeune de l'épreuve, il suffit de remplacer la commande Exit For par Exit Sub dans la macro :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
Sub MettreEnEvidenceLePlusJeuneParCategorie(ByVal FeuilleEncours As Worksheet, ByVal TitreLigne As Long, ByVal Sexe As String)
 
    If ChargementMatriceCategories(Sexe) = True Then
        With FeuilleEncours
             .Cells.Interior.Color = xlNone  ' Pour effacer les couleurs existantes
             ColonneCategorie = 6
             DerniereLigneEpreuve = .Cells(.Rows.Count, 1).End(xlUp).Row
             If DerniereLigneEpreuve > TitreLigne Then
                Set AireCategories = .Range(.Cells(TitreLigne + 1, ColonneCategorie), .Cells(DerniereLigneEpreuve, ColonneCategorie))
                For I = LBound(MatriceCategories, 2) To UBound(MatriceCategories, 2)
                        For Each CelluleCategories In AireCategories
                            If CelluleCategories = MatriceCategories(0, I) Then
                               With .Range(.Cells(CelluleCategories.Row, 1), .Cells(CelluleCategories.Row, 9))
                                    .Interior.Color = MatriceCategories(1, I)
                                    .Font.Color = MatriceCategories(2, I)
                                     Exit For
                                   ' Exit Sub  ' Pour ne mettre en évidence que le premier de la plus jeune des catégories.
                                End With
                             End If
                        Next CelluleCategories
                Next I
                Set AireCategories = Nothing
            End If
        End With
    End If
 
End Sub

Nb : Pour neutraliser la commande Exit For, ajouter un ' en tête de ligne, et supprimer celui devant Exit Sub.

Vous pouvez également ajouter

Code:

.Cells.Interior.Color = xlNone

dans le code pour effacer les couleurs existantes comme dans la procédure ci-dessus.

Un ancien de la rue Jules Renard à Château Gontier.

Cordialement.