Couleurs Poste de travail dans ListView

Le 01/04/2020 à 14:25

Bonjour le Forum,

Dans ma ListView j'ai 4 postes de travail.

J'aimerais si cela est possible c'est qu'ils soient de couleurs différentes pour une meilleures vue

Soit colorier la ligne entièrement ou simplement le poste.

Exemple

Serrurerie en rouge

Électricité en bleu

Mécanique en jaune

Plomberie en vert

Merci d'avance de votre aide

Balance58

18couleurs-poste-de-travail-dans-listview.xlsm (98.99 Ko)
Le 01/04/2020 à 20:44

Bonjour,

J'ai choisi le mauve au lieu du jaune, car en jaune c'est illisible.

Un essai ...

Sub ChargerLW1(Eqp_T)
    With ListView1
        DLig = Range("GA65536").End(xlUp).Row
        Set EqP = Range("GA1:GA" & DLig).Find(Eqp_T, lookat:=xlWhole)
        If EqP Is Nothing Then
            Exit Sub
        Else
            Lig = EqP.Row
        End If
        NCol = CInt(Sheets(1).Range("GB1").Column)
        NColGroup = NCol - 1
        While Cells(Lig, NColGroup).Text = Eqp_T
            .ListItems.Add , , Cells(Lig, NCol).Text
            For ind = 1 To 12
                NCol = NCol + 1
                .ListItems(.ListItems.Count).ListSubItems.Add , , Cells(Lig, NCol).Text
                If ind = 2 Then
                    If .ListItems(.ListItems.Count).ListSubItems(ind) = "Mécanique" Then
                        .ListItems(.ListItems.Count).ListSubItems(ind).ForeColor = RGB(100, 75, 125)  ' mauve
                        .ListItems(.ListItems.Count).ListSubItems(ind).Bold = True
                    End If
                    If .ListItems(.ListItems.Count).ListSubItems(ind) = "Serrurier" Then
                        .ListItems(.ListItems.Count).ListSubItems(ind).ForeColor = RGB(234, 46, 0)     ' rouge
                        .ListItems(.ListItems.Count).ListSubItems(ind).Bold = True
                    End If
                    If .ListItems(.ListItems.Count).ListSubItems(ind) = "Électricité" Then
                        .ListItems(.ListItems.Count).ListSubItems(ind).ForeColor = RGB(70, 90, 250)  ' bleu
                        .ListItems(.ListItems.Count).ListSubItems(ind).Bold = True
                    End If
                    If .ListItems(.ListItems.Count).ListSubItems(ind) = "Plomberie" Then
                        .ListItems(.ListItems.Count).ListSubItems(ind).ForeColor = RGB(32, 240, 32)    ' vert
                        .ListItems(.ListItems.Count).ListSubItems(ind).Bold = True
                    End If
                End If
            Next ind
            NCol = NColGroup + 1
            Lig = Lig + 1
        Wend
    End With
End Sub

ric

Le 02/04/2020 à 10:08

Bonjour le Forum,

Bonjour Ric,

Merci pour le code qui fonctionne correctement sur le fichier test.

Mais malheureusement j'ai fait une erreur de fichier, ayant fait plusieurs tests sur différents fichiers et ba je me suis trompé de fichier.

Voila le bon ChargerLW1()

J'ai essayer de placer ton code mais je ne suis pas arriver à le faire fonctionner.

Sub ChargerLW1()

With ListView1

Dlig = Application.CountA([GA1:GA551])

For Lig = 2 To Dlig

If Cells(Lig, 183) = Label57 Then

.ListItems.Add , , Cells(Lig, 184)

For col = 185 To 197

.ListItems(.ListItems.Count).ListSubItems.Add , , Cells(Lig, col)

Next

End If

Next

End With

End Sub

Bonne journée à tous et merci

Balance58

Le 02/04/2020 à 11:41

Bonjour,

Ton profil mentionne que tu utilises Excel 2007, est-ce bien la version d'Excel que tu utilises ?

Est-il possible de nous faire parvenir le nouveau fichier ?

ric

Le 02/04/2020 à 14:40

Re Bonjour le Forum et Ric,

J'utilise toujours Excel 2007.

Voila le nouveau fichier.

16couleurs-poste-de-travail-dans-listview-v2.xlsm (67.59 Ko)

A+

Balance58

Le 02/04/2020 à 15:01

Bonjour,

Peut-être ainsi ...

Dim Lcol As Integer

    With ListView1
        DLig = Application.CountA([GA1:GA551])
        For Lig = 2 To DLig
            If Cells(Lig, 183) = Label57 Then
                .ListItems.Add , , Cells(Lig, 184)
                For col = 185 To 197
                    .ListItems(.ListItems.Count).ListSubItems.Add , , Cells(Lig, col)

                    If col = 187 Then
                        Lcol = col - 185
                        If .ListItems(.ListItems.Count).ListSubItems(Lcol) = "Mécanique" Then
                            .ListItems(.ListItems.Count).ListSubItems(Lcol).ForeColor = RGB(100, 75, 125)  ' mauve
                            .ListItems(.ListItems.Count).ListSubItems(Lcol).Bold = True
                        End If
                        If .ListItems(.ListItems.Count).ListSubItems(Lcol) = "Serrurier" Then
                            .ListItems(.ListItems.Count).ListSubItems(Lcol).ForeColor = RGB(234, 46, 0)     ' rouge
                            .ListItems(.ListItems.Count).ListSubItems(Lcol).Bold = True
                        End If
                        If .ListItems(.ListItems.Count).ListSubItems(Lcol) = "Électricité" Then
                            .ListItems(.ListItems.Count).ListSubItems(Lcol).ForeColor = RGB(70, 90, 250)  ' bleu
                            .ListItems(.ListItems.Count).ListSubItems(Lcol).Bold = True
                        End If
                        If .ListItems(.ListItems.Count).ListSubItems(Lcol) = "Plomberie" Then
                            .ListItems(.ListItems.Count).ListSubItems(Lcol).ForeColor = RGB(32, 240, 32)    ' vert
                            .ListItems(.ListItems.Count).ListSubItems(Lcol).Bold = True
                        End If
                    End If

                Next col
            End If
        Next
    End With
End Sub

ric

Le 02/04/2020 à 15:28

Bonjour,

Si tu voulais, par hasard, obtenir le même effet en ListView2.

Aussi, tu pourrais séparer ListView2 de la macro "Initialize" tel ListView1. Mais, c'est toi qui voit.

Même la partie de la ListView1 qui est dans "Initialize pourrait être rapatrié dans "ChargerLW1" pour faire plus propre. 

Private Sub UserForm_Initialize()
Dim col As Integer
    Equipe_1 = Selection.Offset(, -9)
    Equipe_2 = Selection.Offset(, 5)
    Label57 = Equipe_1
    col = Application.Match(Label57, Feuil55.Rows(2), 0)
    With ListView1
        With .ColumnHeaders
            .Clear    'Supprime les anciens entêtes
            'Ajout des colonnes
            .Add , , "Code", 30, lvwColumnLeft
            .Add , , "Nom - Prénom", 105, lvwColumnLeft
            .Add , , "Poste", 70, lvwColumnCenter
            .Add , , " ", 35, lvwColumnCenter
            .Add , , " ", 35, lvwColumnCenter
            .Add , , " ", 35, lvwColumnCenter
            .Add , , " ", 35, lvwColumnCenter
            .Add , , " ", 35, lvwColumnCenter
            .Add , , " ", 35, lvwColumnCenter
            .Add , , " ", 35, lvwColumnCenter
            .Add , , " ", 35, lvwColumnCenter
            .Add , , " ", 35, lvwColumnCenter
            .Add , , " ", 35, lvwColumnCenter
            .Add , , " ", 0, lvwColumnCenter
        End With

        .View = lvwReport    'affichage en mode Rapport
        .Gridlines = True    'affichage d'un quadrillage
        .FullRowSelect = True    'Sélection des lignes comlètes
        .LabelEdit = lvwManual    ' On ne modifie pas en direct
    End With

    With ListView2
        With .ColumnHeaders
            .Clear    'Supprime les anciens entêtes
            'Ajout des colonnes
            .Add , , "Code", 30, lvwColumnLeft
            .Add , , "Nom - Prénom", 80, lvwColumnLeft
            .Add , , "Poste", 70, lvwColumnCenter
        End With

        Set c = Worksheets("liste").Range("A2").Find(semaine.Equipe_1)
        For i = 1 To 40
            With .ListItems
                .Add , , Worksheets("liste").Cells(i + 3, col).Value
            End With
            .ListItems(i).ListSubItems.Add , , Worksheets("liste").Cells(i + 3, col + 1).Value
            .ListItems(i).ListSubItems.Add , , Worksheets("liste").Cells(i + 3, col + 2).Value
                Lcol = 2
                If .ListItems(i).ListSubItems(Lcol) = "Mécanique" Then
                    .ListItems(i).ListSubItems(Lcol).ForeColor = RGB(100, 75, 125)  ' mauve
                    .ListItems(i).ListSubItems(Lcol).Bold = True
                End If
                If .ListItems(i).ListSubItems(Lcol) = "Serrurier" Then
                    .ListItems(i).ListSubItems(Lcol).ForeColor = RGB(234, 46, 0)     ' rouge
                    .ListItems(i).ListSubItems(Lcol).Bold = True
                End If
                If .ListItems(i).ListSubItems(Lcol) = "Électricité" Then
                    .ListItems(i).ListSubItems(Lcol).ForeColor = RGB(70, 90, 250)  ' bleu
                    .ListItems(i).ListSubItems(Lcol).Bold = True
                End If
                If .ListItems(i).ListSubItems(Lcol) = "Plomberie" Then
                    .ListItems(i).ListSubItems(Lcol).ForeColor = RGB(32, 240, 32)    ' vert
                    .ListItems(i).ListSubItems(Lcol).Bold = True
                End If

        Next
        .View = lvwReport 'affichage en mode Rapport
        .Gridlines = True 'affichage d'un quadrillage
        .FullRowSelect = True 'Sélection des lignes comlètes
        .LabelEdit = lvwManual    ' On ne modifie pas en direct

End With
ChargerLW1
End Sub

ric

Le 02/04/2020 à 15:38

Bonjour,

Excuse-moi si je ne donne que le code. J'ai un problème avec ListView sur ma machine munie d'Excel 2007.

Il faut que je dépanne cela prochainement.

ric

Le 02/04/2020 à 16:04

Bonjour,

J'ai enfin dépanné cette vilaine machine.

ric

15balance58-couleurs-poste-de-travail-dans-listview-v4.xlsm (68.66 Ko)
Le 02/04/2020 à 16:22

Re,

Merci pour le fichier c'est super. Merci

Tes codes sont formidable je t'en remercie cela fonctionne à merveille.

(Même la partie de la ListView1 qui est dans "Initialize pourrait être rapatrié dans "ChargerLW1" pour faire plus propre

) oui pourquoi pas, mais la je te laisse faire.

et une dernière demande :

Quand je choisi un nom dans la ListView2 et que je clic sur " AJOUTER NOM " est t'il possible de colorier le poste choisi directement dans la ListView1.

Encore merci

Balance58

Le 02/04/2020 à 16:39

Bonjour,

oui pourquoi pas, mais la je te laisse faire.

Je reviens ...

ric

Le 02/04/2020 à 17:25

Bonjour,

Quand je choisi un nom dans la ListView2 et que je clic sur " AJOUTER NOM " est t'il possible de colorier le poste choisi directement dans la ListView1.

Là, je vais avoir besoin de précision ...

Au départ, les postes de ListView1 ne seraient pas colorés.

En cliquant sur bouton "AJOUTER NOM", le poste en ListView1 serait colorié ?

Est-ce bien ton souhait ?

ric

Le 02/04/2020 à 17:42

Re,

Oui c'est bien ça.

Au départ à l'ouverture de l'USF la Listview1 est vide, ont la remplis avec la Listview2

Le 02/04/2020 à 22:36

Bonjour,

... En cliquant sur bouton "AJOUTER NOM", le poste en ListView1 serait colorié ? ...

... à l'ouverture de l'USF la Listview1 est vide, ont la remplis avec la Listview2 ...

Je viens d'allumer. Désolé

ric

Le 02/04/2020 à 22:58

Bonsoir Ric et le Forum,

Je te remercie beaucoup pour ton aide.

Mais avec le fichier cela serait mieux.

Avec je comprendrais mieux comme tu as procéder.

Bonne soirée à toi et au Forum

Balance58

Le 03/04/2020 à 02:05

Bonjour,

Je n'ai pas compris le besoin.

Si l'on clique sur le bouton "AJOUTER NOM", le poste dans ListView1 se colorise s'il est le même que le poste affiché dans "catg".

Pour l'instant, qu'un seul poste peut être coloré. Les multiples instances de ce poste seront colorées.

ric

9balance58-couleurs-poste-de-travail-dans-listview-v6.xlsm (73.87 Ko)
Le 03/04/2020 à 09:45

Bonjour Ric et le Forum,

Merci de ton aide, c'est super.

Cela fonctionne très bien.

Encore merci

Bonne journée à toi et au Forum

Balance58

Le 04/04/2020 à 09:16

Bonjour le Forum,

Bonjour Ric,

J'ai pu que regarder à fond ton fichier hier soir pour comprendre tes codes.

et la j'ai remarquer 2 bugs.

Pour l'instant, qu'un seul poste peut être coloré. Les multiples instances de ce poste seront colorées

Que veut tu dire exactement ?

  • Tu insère un nom il est bien colorié à sa couleur, tu en insère un 2ème il est bien colorié aussi mais il supprime le coloriage de l'autre. A chaque fois que tu ajoute un nom cela efface les autres.
  • Et quand tu clic sur un nom dans la ListView1 : Message

Erreur d'exécution '35600'

Index out of bounds

et en jaune : dans Private Sub Listview1_ItemClick(ByVal Item As MSComctlLib.ListItem)

Lig = ListView1.ListItems(Lig).ListSubItems(13)

Si tu à une solution merci d'avance

Bonne journée à toi et au Forum.

Balance58

Le 04/04/2020 à 10:32

Bonjour,

Pour l'erreur 35600, c'est corrigé.

Pour la couleur aussi.

ric

13balance58-couleurs-poste-de-travail-dans-listview-v8.xlsm (77.97 Ko)
Le 04/04/2020 à 14:32

Rebonjour à tous,

Merci de nouveau ric pour ce fichier.

Les couleurs fonctionnent bien, mais j'ai toujours l'erreur " 35600 " quand je clic sur " VALIDER NOM " après avoir choisi un nom dans la ListView1.

A+

Balance58

Rechercher des sujets similaires à "couleurs poste travail listview"