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 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90
|
Private Sub txtRefMUT_Change()
Dim a As Variant
Dim Sh As Worksheet
Dim i As Integer, j As Integer
Dim MonTest As Integer
Dim Msg
'Dim b As Variant
On Error GoTo GestERR
'' **** ' On Error Resume Next '***********
' On Error GoTo txtRefMUT_Change_Error
Set Sh = Sheets("Fiche N°5")
lbInfo.ForeColor = &HC00000
a = Sh.Range("A3:L" & Sh.[A65000].End(xlUp).Row)
Dim B()
Dim C()
j = 0
Me.lstExposition.Clear
Me.lstExposition.ColumnCount = 13
lstExposition.ColumnHeads = False
MonTest = 0
Me.lstExposition.ColumnWidths = "60;35;20;20;20;30;60;55;35;67;50;100;10"
For i = LBound(a) To UBound(a) 'traite chaque ligne du tableau (a)
'' **** ' On Error GoTo 0 '***********
If a(i, 2) = txtRefUT Then
MonTest = 1 + MonTest
j = j + 1
ReDim Preserve B(1 To 13, 1 To j)
B(1, j) = a(i, 1)
B(2, j) = a(i, 2)
B(3, j) = a(i, 3)
B(4, j) = a(i, 4)
B(5, j) = a(i, 5)
B(6, j) = a(i, 6)
B(7, j) = a(i, 7)
B(8, j) = a(i, 8)
B(9, j) = a(i, 9)
B(10, j) = a(i, 10)
B(11, j) = a(i, 11)
B(12, j) = a(i, 12)
B(13, j) = i + 2
End If
Next i
If MonTest = 0 Then
lbInfo.Caption = "Aucune donnée pour ce choix"
lbInfo.ForeColor = &H800000
lstExposition.Clear
ElseIf MonTest = 1 Then
'lstExposition.Clear
Me.lstExposition.AddItem
Me.lstExposition.List(0, 0) = B(1, j) 'N°RiskHM
Me.lstExposition.List(0, 1) = B(2, j) 'MUT
Me.lstExposition.List(0, 2) = B(3, j)
Me.lstExposition.List(0, 3) = B(4, j)
Me.lstExposition.List(0, 4) = B(5, j)
Me.lstExposition.List(0, 5) = B(6, j)
Me.lstExposition.List(0, 6) = B(7, j) '<<<< je pense bug ici si manque de données
Me.lstExposition.List(0, 7) = B(8, j)
Me.lstExposition.List(0, 8) = B(9, j)
Me.lstExposition.List(0, 9) = B(10, j)
Me.lstExposition.List(0, 11) = B(12, j)
Me.lstExposition.List(0, 12) = B(13, j)
lbInfo.Caption = "1 ITEM pour cette Option"
lbInfo.ForeColor = &HFF00FF
Else
C = Application.Transpose(B)
Me.lstExposition.List = C
lbInfo.Caption = "ATTENTION =>> " & MonTest & " << ITEM à évaluer pour cette Option MUT"
lbInfo.ForeColor = &HFF00FF
End If
Exit Sub
GestERR:
Err.Clear '<<< = BUG
Resume Next
' On Error GoTo 0
' Exit Sub
'txtRefMUT_Change_Error:
' Exit Sub
' MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure txtRefMUT_Change of Feuille F_Item"
'Msg = "L'erreur # " & Str(Err.Number) & " a été générée par " & Err.Source & Chr(13) & Err.Description
' MsgBox Msg, , "Erreur", Err.HelpFile, Err.HelpContext
End Sub |
Partager