Discussion :

[IronHeavy]

J'ai réalisé un premier formulaire qui identifie les risques professionnels de chaque activités de mon entreprise.

Mon dernier objectif est d'affecter à chaque salarié une fiche d'exposition individuelle, compilant les risques rencontrés pour toutes les activités qu'ils effectuent:

Ma Listbox 2 s'emplit enfin des noms de secteurs d'activités, modifiable via mes ToggleButtons.

Je souhaite afficher les risques professionnels de chacune de ces activités dans ma ListBox1 (sans doublons).

Je dispose d'une formule fonctionnelle dans un autre USF qui, à partir de la sélection d'une Combobox, alimente une listBox identique. (codes proposés par JacquesBoisgonthier et Ben_L).

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
28
29
30
  Private Sub ComboBox1_Click()
    Dim F As Worksheet, bd As Variant, i As Integer, temp As Variant
    Me.TextBox1.Value = Me.ComboBox1.Text
    Me.ListBox1.Clear
    Set F = Sheets(Me.TextBox1.Text)
    bd = F.Range("F9:J" & F.[F65000].End(xlUp).Row).Value2  ' tableau bd(n,1) pour rapidité
    For i = LBound(bd) To UBound(bd)
        If bd(i, 1) <> "" Then Call AddArrayElm(temp, Array(bd(i, 1), bd(i, 3), bd(i, 4), bd(i, 5)))
    Next i
 
    Me.ListBox1.ColumnCount = 4
    Me.ListBox1.List = Application.Transpose(temp) 
 
 Private Sub AddArrayElm(Arr As Variant, Elm As Variant)
    Dim i As Long, nRow As Long, nCol As Long
    nCol = UBound(Elm)
    If Not IsArray(Arr) Then
        nRow = 0
        ReDim Arr(nCol, nRow)
    Else
        nRow = UBound(Arr, 2) + 1
        For i = 0 To nRow - 1
            If Elm(0) = Arr(0, i) Then Exit Sub
        Next i
        ReDim Preserve Arr(nCol, nRow)
    End If
    For i = 0 To nCol
        Arr(i, nRow) = Elm(i)
    Next i
End Sub

Comment adapter ce code pour que de sélection d'un unique item de Combobox1, je puisse passer à chaque item d'une ListBox2?

[IronHeavy]

Le Week End est passé, je n'ai toujours pas trouvé de solution qui fonctionne... Et je dois présenter mon fichier à la direction mercredi!

[boisgontierjacques]

Bonjour,

Avec un fichier joint, il deviendrait plus facile comprendre la question!

Boisgontier

[IronHeavy]

Bonjour,

Ci joint un extrait dudit fichier.Copie de extrait évaluation des risques test.xlsm

[Invité]

Bonjour,
déjà ça t'éviteras des doublons!

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
 
Private Sub ComboBox1_Click()
Dim F As Worksheet, bd As Variant, i As Integer, temp As Variant, j As Long, ToggleButton As Control, Ligne As Long
    Me.ListBox1.Clear
    Me.ListBox2.Clear
    Set F = Sheets("LISTE SALARIES")
    Ligne = Me.ComboBox1.ListIndex + 5
    Me.TextBox1 = F.Cells(Ligne, 2)
    Me.ComboBox2 = F.Cells(Ligne, 4)
    Me.ComboBox3 = F.Cells(Ligne, 5)
For i = 0 To 17
    Me.Controls("ToggleButton" & (1 + i)) = False
   Me.Controls("ToggleButton" & (1 + i)) = F.Cells(Ligne, 6).Offset(, i) = "OUI"
   Me.Controls("ToggleButton" & (1 + i)).BackColor = IIf(Me.Controls("ToggleButton" & (1 + i)) = True, vbGreen, vbRed)
Next
End Sub

[IronHeavy]

: impressionnant... merci!!

reste l'alimentation de la listbox1...

[boisgontierjacques]

Une autre approche

Boisgontier
http://boisgontierjacques.free.fr

[IronHeavy]

Merci Jacques,

La partie "dynamique" ne semble pas fonctionnelle ? Si j'ajoute une fonction/activité à un salarié, les risques identifiés pour cette fonction ne s'incrémentent pas en en temps réel...

D'autre part, la liste des risques identifiée par fonction/activité étant amenée à évoluer régulièrement, ma crainte est que de passer par un tableau relais serait sujet à dysfonctionnements.

Une solution sans relai serait (de mon point de vue):

Si case "administratif" cochée, alors chercher dans la page "ADMINISTRATIF" colone F "RISQUES" la liste des risques identifiés et les ajouter à la ListBox
PUIS, si case "agroalimentaire " vide, alors rien
PUIS,...
PUIS si case "VITRERIE" cochée, alors chercher dans la page "VITRERIE" colone F "RISQUES" la liste des risques identifiés et les ajouter à la ListBox

ENSUITE, Trier et supprimer les doublons

ENFIN, afficher les logos des risques auxquels le salarié est exposé

ceci est bien évidemment au dessus de mes compétences!

remarque:

En bleu, j'ai déjà des bribes de codes fonctionnelles

En rouge, je n'ai pas d'idée pour la rédaction de ces passages, c'est cela qu'il me faudrait je pense....

[boisgontierjacques]

Nouvelle version.

Boisgontier

[IronHeavy]

Merci pour cette MAJ Jacques.

Cette solution nécessite de recourir à un tableau - actuellement non existant - dont le remplissage est conditionné aux évolutions de mon fichier.

N'y aurait-il un moyen de sauter cette étape?

[boisgontierjacques]

Cf PJ

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
 
Dim f, bd()
Private Sub UserForm_Initialize()
  Set f = Sheets("bd")
  bd = f.Range("A3:W" & f.[A65000].End(xlUp).Row).Value
  Me.ComboBox1.List = Application.Index(bd, , 1)
  Me.ListBox1.List = Application.Transpose([Activités])
End Sub
 
Private Sub ComboBox1_click()
  ligne = Me.ComboBox1.ListIndex + 1
  For i = 0 To ListBox1.ListCount - 1
    If bd(ligne, i + 6) = "OUI" Then Me.ListBox1.Selected(i) = True Else Me.ListBox1.Selected(i) = False
  Next i
  ListeRisques
End Sub
 
Private Sub ListBox1_Change()
  ListeRisques
End Sub
 
Sub ListeRisques()
  Set d = CreateObject("scripting.dictionary")
  For i = 0 To ListBox1.ListCount - 1
    If ListBox1.Selected(i) = True Then
       feuille = Me.ListBox1.List(i)
       On Error Resume Next
       Set fr = Sheets(feuille)
       If Err = 0 Then
          For r = 9 To fr.[F65000].End(xlUp).Row
            tmp = fr.Cells(r, "f")
            d(tmp) = ""
          Next r
       End If
       On Error GoTo 0
    End If
  Next i
  Me.ListBox2.List = d.keys
End Sub
 
Private Sub B_valid_Click()
  ligne = Me.ComboBox1.ListIndex + 1 + 2
  For i = 0 To ListBox1.ListCount - 1
    col = i + 6
    If Me.ListBox1.Selected(i) = True Then f.Cells(ligne, col) = "OUI" Else f.Cells(ligne, col) = ""
  Next i
End Sub

Boisgontier

[IronHeavy]

47 lignes...

mes respects!

vous venez de me faire valoir une promotion