Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Autres Couleur des Item et SubItem d'une Listview

bernardrustrel

XLDnaute Occasionnel
Bonjour

Une fois de plus j’en appelle à vos compétences afin de me venir en aide…

Sous XL 2007, au travers du formulaire « UsfCostume » je dois gérer les disponibilités de costumes afin de les prêter. J’ai en fait 2 questions …

1/Dans la lIstView , je voudrais les différencier à l’aide couleur (Rouge : indisponible, Bleu : Prêté)

La Combobox « CbInventaire » permet la sélection de "Tous costumes", "Costumes disponibles", "Costumes prêtés", "Costumes indisponibles".

En sélectionnant "Tous costumes", la différenciation des costumes se fait correctement.

Cependant lorsque je choisis "Costumes disponibles", les costumes indisponibles n’apparaissent pas (ce qui est normal) mais en ce qui concerne la différenciation ça ne fonctionne pas alors que sur le choix précédent tout allait bien.

J’ai certainement du faire une erreur, mais je n’arrive pas à la trouver.

2/ vous avez du remarquer qu’à chaque nouvelle sélection de la ComboBox la ListView s’anime beaucoup. Existe-t-il un moyen de réduire cette animation.

Je vous en remercie par avance.Cordialement Bernard
 

Pièces jointes

  • TestCouleur.xlsm
    42.9 KB · Affichages: 29

patricktoulon

XLDnaute Barbatruc
Bonjour
et ben mon ami quel foutoir
d'abords les engueulades (moi j'aime bien engueuler)
mais ou tu est allé chercher qu'avec l'examen du tableau par une variable tableau on remplissait avec les cells(i,k)
il est évident qu'elle n'ont pas les même index
alors tes i-1 et compagnie on fini par plus se retrouver
aller le module complet a la poubelle
et on va y coller ce code
VB:
Option Explicit
Public Function ExistFeuil(sNomFeuille As String) As Boolean
'********************************************************************************************
' Nom      : ExistFeuil
' But      : Teste si la feuille existe
' Syntaxe  :ExistFeuil(Nom de la feuille)
' Resultat  :Vrai si Feuille existe, Faux si elle n'existe pas
'********************************************************************************************
    On Error GoTo Err_ExistFeuil
    ExistFeuil = False
    ExistFeuil = Not ActiveWorkbook.Worksheets(sNomFeuille) Is Nothing
Err_ExistFeuil:

End Function
Public Sub AlimenteListInventaire(argument)    'la fonction est argumentée par la valeur de la combo

    Dim Coul, TC, arg, ok As Boolean, col, Dernligne, I&, K&
    Sheets("Costumes").Activate
    Dernligne = Sheets("Costumes").Range("A65536").End(xlUp).Row
    TC = Sheets("Costumes").Range("A2:P" & Dernligne).Value
    With UsfCostume
        With .ListView5
            With .ColumnHeaders
                .Clear
                .Add , , "N°", 0
                .Add , , "Groupe", 85, lvwColumnCenter
                .Add , , "Costume", 85, lvwColumnCenter
                .Add , , "D/I", 0    ', lvwColumnCenter
                .Add , , "Prêt", 0
                .Add , , "S", 0, lvwColumnCenter
                .Add , , "M", 0, lvwColumnCenter
                .Add , , "L", 0, lvwColumnCenter
                .Add , , "XL", 0, lvwColumnCenter
                .Add , , "XXL", 0, lvwColumnCenter
                .Add , , "Coiffe", 37, lvwColumnCenter
                .Add , , "Gants", 37, lvwColumnCenter
                .Add , , "Ceinture", 37, lvwColumnCenter
                .Add , , "Jupon", 37, lvwColumnCenter
                .Add , , "Chaussures", 37, lvwColumnCenter
                .Add , , "Obs", 0
            End With
            .FullRowSelect = True    'Permet le sélection de toute la ligne
            .View = lvwReport    'Affichage en mode Rapport
            .Gridlines = True
            'Cost = 0
            .ListItems.Clear
            '----------------------------
            UsfCostume.TextBox2 = 0
            UsfCostume.TextBox3 = 0
            UsfCostume.TextBox4 = 0

            'ici on va gérer 2 argument colonne et valeur  dans col4 et 5 en fonction de la valeur de la combo
            ' donc selon la valeur on examine la colonne 4 ou 5
            Select Case argument
            Case "Tous costumes": arg = "*": col = 4
            Case "Costumes disponibles": arg = "D": col = 4
            Case "Costumes prêtés": arg = "*": col = 5
            Case "Costumes indisponibles": arg = "I": col = 4
            End Select

            'ici une variable tableau issue d'une plage est toujours en base 1 on commence a 1 et non 2 comme tu le faisait
            ' ET PUIS QUAND ON TRAVAIL L'EXAMEN AVEC UNE VARIABLE TABLEAU ON NE SE SERT PAS DE CELLS(i,k)MAIS DE TC(i,k)
            ' espece de saucisse !!!!!!!
            For I = 1 To UBound(TC, 1)
                ok = False
                If col <> 5 Then If CStr(TC(I, col)) Like arg Then ok = True    'si col et arg correspondent alors ok =True
                If col = 5 Then If Val(TC(I, col)) > 0 Then ok = True    ' pareille memeprincipe pour la colonne 5 si choix "pretés"

                If ok = True Then    'si ok donc on envoie la sauce
                    'la couleur si col 4 ou 5  ="D" ou "I" ou col5>0
                    If TC(I, 4) = "I" Then Coul = vbRed Else Coul = vbBlack
                    If TC(I, 5) <> "" Then Coul = vbBlue Else Coul = Coul

                    .ListItems.Add , , TC(I, 1)
                    For K = 2 To 16
                        .ColumnHeaders(K).Alignment = lvwColumnCenter
                        .ListItems(.ListItems.Count).ListSubItems.Add , , TC(I, K), , lvwColumnCenter
                    Next
                   For K = 1 To 15: .ListItems(.ListItems.Count).ListSubItems(K).ForeColor = Coul: Next K
                End If
                'et voila c'est comme chez Renault "c'est simple"

                ' maintenant les décomptes dans textboxs
                If TC(I, 4) = "D" Then UsfCostume.TextBox2 = UsfCostume.TextBox2 + 1
                If TC(I, 5) > 0 Then UsfCostume.TextBox3 = UsfCostume.TextBox3 + 1
                UsfCostume.TextBox4 = UsfCostume.TextBox4 + 1

            Next
        'termineé
        End With
    End With
End Sub

Public Sub OuvreForm()
    UsfCostume.Show
End Sub
voila tu a les couleurs et les liste selon le choix combo
bien entendu j'ai modifié les appels de la sub dans le userform car elle est maintenant argumentée
pour les scintillement lors de changement dans la combo c'est un peu normal tu clear la listview pour la re remplir il est évident qu'avec ce control il y est un effet de ce genre
voila
 

Pièces jointes

  • TestCouleur.xlsm
    37.9 KB · Affichages: 12

ChTi160

XLDnaute Barbatruc
Bonsoir bernardrustrel
Bonsoir le Fil (Patrick) ,le Forum
j'ai suivi les indications de Patrick et j'ai eu plein de problèmes après avoir collé le code proposé dans le Module.
argument de fonction manquant etc
enfin du beau travail que j'ai remanié (c'est perfectible)
Bonne fin de Soirée
jean marie
 

Pièces jointes

  • TestCouleur Chti160.xlsm
    42.5 KB · Affichages: 11

ChTi160

XLDnaute Barbatruc
Re
Oui t'inquiète Lol
mais si on colle le Code dans le fichier fourni ca Bug Lol
Tu disais :
"aller le module complet a la poubelle
et on va y coller ce code"
c'est ce que j'ai fais Lol et là Bug
Bonne fin de Soirée
jean marie
 

patricktoulon

XLDnaute Barbatruc
a ben oui il faut argumenter tout les appels dans l'usf bien sur
je l'avais pourtant écrit en gros et rouge
j'ai regardé ton fichier
une écriture un peu différente certaines données variabilisées et un bloc with pour l'userform
mais bon perso les textboxs étant des objects bien distincts( 3 éléments)je ne vois pas l'utilité d'utiliser 3 variables pour instruire 3 textboxs
les accès direct sont plus facile a comprendre pour un débutant
nous nous sommes des barbatrucs ont sait lire et ecrire un code de cette manière , un débutant moins
et vu le code fourni à la base notre ami Bernard ne maîtrise pas bien les nuances (base1/base0) les index et autres et les imbrication dans une boucle sur variables tableaux
on fait des bloc with et plein de petites choses quand on maîtrise le reste

cela dit en lecture sur ton fichier on est bons
avec ca si Bernard ne comprends pas ben je mange ma mouse
 

ChTi160

XLDnaute Barbatruc
Bonjour pour ce qui est du Scintillement, il vient aussi du fait qu'a chaque changement de Choix la ListView est a chaque fois reconfigurée.
j'ai donc mis la Configuration dans le Intialize du Userform une fois pour toute.
le fichier ou j'ai encore modifié quelques trucs Lol !
Bonne journée
Jean marie
 

Pièces jointes

  • TestCouleur Chti160.xlsm
    43.8 KB · Affichages: 12

bernardrustrel

XLDnaute Occasionnel
Bonjour
Dans tous les cas merci à tous deux de vos conseils, ils me permettront de m'améliorer en la matière.
Il est vrai que je suis un peu brouillon.
J'ai fini par trouver mon erreur, vos solutions sont dans tous cas plus élégantes que le pataquès que j'avais élaboré.
Encore un grand merci à tous deux
Cordialement Bernard
 

patricktoulon

XLDnaute Barbatruc
Bonjour a tous
la oui !!!! @ChTi160 c'est une vrai amélioration!!!! pour le scintillement
je ne regarde pas le code je te fait confiance

hoh la!!! j'aurais du regarder
tous et disponible donnent la même liste ça ne fonctionne donc plus la dépendance combobox

pour "Disponible" le st papoul rouge ne devrait être dans la liste
 
Dernière édition:

ChTi160

XLDnaute Barbatruc
Re
effectivement
y'avait une erreur dan le Code
VB:
Case "Dsponibles" au lieu de Case "Disponibles"
ca semble Fonctionner Lol
mais doit on considérer qu'un élément Prêté est disponible Lol
ou alors le terme Disponible n'est pas adapté ?
merci Patrick
jean marie
 
Dernière édition:

patricktoulon

XLDnaute Barbatruc
re
je sais que je suis un peu chiant mais bon c'est plus fort que moi
je teste pas je continue a te faire confiance
là je te re aime
là oui tu a apporté une véritable amélioration a mon code de départ
j'aurais peut être continué sur module et pas séparer usf/module
histoire de rester dans le principe que le demandeur avait mis en place
pour ne pas le perdre

tu met une sub init_listview dans le module
tu remet le code du initialise dedans tu dim les variables
et dans le initialise tu appelle la init_listview
 

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…