ajouter la date listebox2

1 pièce(s) jointe(s)

bonsoir

je voulais savoir si il y a une personne qui pourrait m'aider ,

voilà je voudrais rajouter la date colonne26 corespondante au shémas dans la listbox2

j'ai éssayé plusieur test mais en vain

voici un apercu de mon programme

merci pour votre aide

Bonsoir

essaye ça

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
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
Private Sub Lancer_Click()
Dim i As Integer, j As Integer, ColR As Byte, ColV As Byte, ColB As Integer
Dim Colect1 As New Collection, Result As Boolean
Dim Colect2 As New Collection
Result = False
 
 
 
   If ComboBox1 = "" Then
   MsgBox "Veuillez sélectionner une condition à la case" & Chr(13) & "  Rechercher par !", vbInformation, "RECHERCHER"
    Exit Sub
   End If
 
 
   If TextBox1 = "" Then
   MsgBox "Veuillez sélectionner une condition à la case" & Chr(13) & "  Entrez vos données !", vbInformation, "RECHERCHER"
    Exit Sub
   End If
 
 
Select Case Me.ComboBox1.Value
    Case "T.A.G"
        ColR = 7
        ColV = 5
       ColB = 4
 
 
        Case "Shémas 9S"
        ColR = 5
        ColV = 7
        ColB = 4
End Select
 
With Sheets("Feuil4")
 
    For i = 2 To .Cells(Rows.Count, ColR).End(xlUp).Row
        If .Cells(i, ColR).Text = Me.TextBox1 Then
            Result = True
       Colect1.Add .Cells(i, ColV).Text, CStr(.Cells(i, ColV))
       Colect2.Add .Cells(i, 26).Text, CStr(.Cells(i, 26))
        End If
    Next i
 
 
 
End With
 
If Result = True Then
    Me.TextBox2 = "EXISTANT"
 
    For i = 1 To Colect1.Count
        Me.ListBox1.AddItem Colect1.Item(i)
     Next i
 
     For i = 1 To Colect2.Count
            Me.ListBox2.AddItem Colect2.Item(i)
     Next i
 
     Else
     Me.TextBox2 = "INEXISTANT"
     End If
 
    End Sub

ajouter la date dans listbox2

cool sa marche,

merci beaucoup:lol:

J'ai modifié quelques détails dans tes messages "selectionner une condition..."

et peut-etre peut tu changer le 26 par la variable correspondante, je crois colb = 26

bonne soirée

ajouter la date dans listbox2

bonsoir

je pensais que le pb été résolu,
mais quand je me positionne sur shémas 9S et je rentre une donnée du type D4 9013 par exemple et si la date en colonne 26 et identique sur plusieur ligne alors cela m'affiche une message erreur 457

y a t il un solution pour remédier à ça?

Bonjour
As tu supprimer les zones de textes ? il faut que tu le fasse
Voici le code pour l'userform « éditer les tests de sécurité »tu va remplacer toute le code par ceci
vous utiliser un filtre automatique sur la feuil4 attention ce filtre ne vous permet pas de utiliser plus que 1000 mot et il faut que rien ne soit filtrer si vous utiliser l'userform « éditer les tests de sécurité »
La structure de la base de donne ne permet pas des recherches filtrages rapide et consomme beaucoup d'espace tester ce code et si il y a des erreurs tu va retourner votre ancien Valider_Click()

premiere parti parceque le PM ne permet pas des message plus que 1000 caractere

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
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
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
 
Function SetList(this As ComboBox, ParamArray params() As Variant)
Dim oCollection As New Collection, stmps As String
Dim j, sRow, zt, tp, paramid, b, Refs As Long, elements, elem As Variant
Dim setfind As Boolean
sRow = Feuil4.Range("a" & Rows.Count).End(xlUp).Row
Refs = 100
setfind = True
paramid = UBound(params)
ReDim Tableau(Refs)
For b = 1 To sRow Step Refs
Tableau = Feuil4.Range("A1:D" & Refs).Offset(b, 0).Value
For zt = 1 To Refs
setfind = True
For tp = 1 To paramid
If (params(tp) <> Trim(Tableau(zt, tp))) Then
setfind = False
Exit For
End If
Next
If setfind Then
stmps = Trim(Tableau(zt, paramid + 1))
If stmps <> "" Then
On Error Resume Next
oCollection.Add stmps, CStr(stmps)
Err.Clear
End If
End If
Next
Next
If oCollection.Count > 0 Then
ReDim ss(oCollection.Count - 1, 0): j = 0
For Each elem In oCollection
ss(j, 0) = elem: j = j + 1
Next: this.List = ss
End If
SetList = oCollection.Count
End Function
 
Private Sub UserForm_Initialize()
Dim i As Long
i = SetList(ComBox1, "")
End Sub
Private Sub ComBox1_Change()
Dim i As Long
ComBox2.Clear
i = SetList(ComBox2, "", ComBox1.Value)
ComBox2_Change
End Sub
Private Sub ComBox2_Change()
Dim i As Long
ComBox3.Clear
i = SetList(ComBox3, "", ComBox1.Value, ComBox2.Value)
If i > 1 Then
ComBox3.AddItem ("Tous")
End If
ComBox3_Change
End Sub
Private Sub ComBox3_Change()
Dim i As Long
ComBox4.Clear
i = SetList(ComBox4, "", ComBox1.Value, ComBox2.Value, ComBox3.Value)
If i > 1 Then
ComBox4.AddItem ("Tous")
End If
 
End Sub
Private Sub CommandButton2_Click()
UserForm1.Hide
End Sub
 
 
Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    TextBox1.Visible = False
    TextBox2.Visible = False
        CommandButton2.ForeColor = &H0&
        CommandButton2.BackColor = &HE0E0E0
            Valider.ForeColor = &H0&
            Valider.BackColor = &HE0E0E0
                Label1.ForeColor = &H0&
                Label2.ForeColor = &H0&
                Label3.ForeColor = &H0&
                Label4.ForeColor = &H0&
                    OptionButton1.ForeColor = &H0&
                    OptionButton2.ForeColor = &H0&
                    OptionButton3.ForeColor = &H0&
                    OptionButton4.ForeColor = &H0&
End Sub
 
Private Sub ComBox1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    TextBox1.Text = "La raffinerie de Provence est découpée en 3 secteur. " _
    & vbCr & "En sélectionnant un des secteurs vous choisissez de vous positionner sur celui-ci!"
        TextBox1.Visible = True
        TextBox2.Text = "Etape 1"
        TextBox2.Visible = True
        Label1.Visible = &HFF0000
        Label1.Visible = True
        Label1.ForeColor = &HFF0000
 
End Sub
 
Private Sub ComBox2_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    TextBox1.Text = "Voici l'ensemble des unités sur Automate de sécurité de ce secteur. "
        TextBox1.Visible = True
        TextBox2.Text = "Etape 2"
        TextBox2.Visible = True
        Label2.ForeColor = &HFF0000
End Sub
 
Private Sub ComBox3_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    TextBox1.Text = "Attention la périodicité indiquée correspond seulement à cette unité! "
        TextBox1.Visible = True
        TextBox1.Text = "Par leur dimension et/ou leur puissance les grosses machines doivent jouir d'une attention particulières ! "
        TextBox1.Visible = True
        TextBox2.Text = "Etape 3"
        TextBox2.Visible = True
        Label4.ForeColor = &HFF0000
End Sub
Private Sub ComBox4_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    TextBox1.Text = "Attention la périodicité indiquée correspond seulement à cette unité! "
        TextBox1.Visible = True
        TextBox2.Text = "Etape 4"
        TextBox2.Visible = True
        Label3.ForeColor = &HFF0000
End Sub
 
 
Private Sub OptionButton1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    TextBox1.Text = "En sélectionnant cette option vous afficherez l'ensemble des tests de sécurités réalisable unité en marche! "
        TextBox1.Visible = True
        TextBox2.Text = "Etape 5"
        TextBox2.Visible = True
        OptionButton1.ForeColor = &HFF0000
 
End Sub
 
Private Sub OptionButton2_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    TextBox1.Text = "En sélectionnant cette option vous afficherez l'ensemble des tests de sécurités réalisable unité à l'arrêt! "
        TextBox1.Visible = True
        TextBox2.Text = "Etape 5 "
        TextBox2.Visible = True
        OptionButton2.ForeColor = &HFF0000
 
End Sub
Private Sub OptionButton3_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    TextBox1.Text = "En sélectionnant cette option vous afficherez l'ensemble des éléments importants pour la sécurités! "
        TextBox1.Visible = True
        TextBox2.Text = "Etape 5"
        TextBox2.Visible = True
        OptionButton3.ForeColor = &HFF0000
End Sub
 
Private Sub OptionButton4_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    TextBox1.Text = "En sélectionnant cette option vous afficherez les tests avec l'ensemble des états! "
        TextBox1.Visible = True
        TextBox2.Text = "Etape 5 "
        TextBox2.Visible = True
        OptionButton4.ForeColor = &HFF0000
End Sub
 
Private Sub Valider_Click()
 
With Application
        .ScreenUpdating = False
        .EnableEvents = False
End With
   If ComBox1 = "" Then
   MsgBox "Veuillez sélectionner une conditions à la case secteur!", vbInformation, "Editer les tests de sécurité"
    Exit Sub
   End If
   If ComBox2 = "" Then
   MsgBox "Veuillez sélectionner une conditions à la case unité!", vbInformation, "Editer les tests de sécurité"
    Exit Sub
   End If
   If ComBox3 = "" Then
   MsgBox "Veuillez sélectionner une conditions à la case grosse machine! ", vbInformation, "Editer les tests de sécurité"
    Exit Sub
   End If
   If ComBox4 = "" And ComBox3 <> "Tous" Then
   MsgBox "Veuillez sélectionner une conditions à la case périodicité! ", vbInformation, "Editer les tests de sécurité"
   Exit Sub
   End If
    Dim Valx, Valy, Valz, Valz1, i As Integer
    Dim critere As String
    Dim critere1 As String
    Dim critere2 As String
    Sheets("Feuil3").Visible = True
    Sheets("Feuil3").Select
    Rows("2").Select
    Selection.ClearContents
    Valx = Me.ComBox1.Value
    Valy = Me.ComBox2.Value
    Valz = Me.ComBox3.Value
    Valz1 = Me.ComBox4.Value
    If Valz = "Tous" Then Valz1 = "Tous"
    'Affectation des variables critere et critere2 en fonction de la valeur des optionbutton
    If OptionButton1 = True Then
    critere = "oui"
    ElseIf OptionButton2 = True Then
    critere1 = "oui"
    ElseIf OptionButton3 = True Then
    critere2 = "oui"
        Else
    critere = "all"
    End If
Dim j, sRow, b, Refs, t, sline, sys1, sys2, cOffset, arapage, buffs, sizes As Long
Dim prn, pging, scol As Long
sline = 1
sys1 = 2
sys2 = 9
cOffset = 1
arapage = 0
buffs = 50
sizes = sys2 + sys1 - 1
ReDim Tmpsp(buffs, sizes)
Refs = 50
ReDim TestA(Refs)
ReDim TestOp(Refs)
ReDim Tableau2(Refs)
ReDim Tableau(Refs)
ReDim Tableau3(Refs)
With Sheets("Feuil4")
sRow = .Range("a" & Rows.Count).End(xlUp).Row
For b = 1 To sRow Step Refs
TestA = .Range("A1:D" & Refs).Offset(b, 0).Value
TestOp = .Range("T1:V" & Refs).Offset(b, 0).Value
Tableau = .Range("E1:F" & Refs).Offset(b, 0).Value
Tableau2 = .Range("K1:S" & Refs).Offset(b, 0).Value
For prn = 1 To Refs
'/////////////////1111111111111
 If TestA(prn, 1) = Valx Then
      If TestA(prn, 2) = Valy Then
           If TestA(prn, 3) = Valz Or Valz = "Tous" Then
                If TestA(prn, 4) = Valz1 Or Valz1 = "Tous" Then
                          If TestOp(prn, 2) = critere Or critere = "all" _
                  Or TestOp(prn, 1) = critere1 Or critere1 = "all" _
                 Or TestOp(prn, 3) = critere2 Or critere2 = "all" Then
'/////////////////222222222222
scol = 0
For t = 1 To sys1
Tmpsp(sline - 1, scol) = Tableau(prn, t)
scol = scol + 1
Next
For t = 1 To sys2
Tmpsp(sline - 1, scol) = Tableau2(prn, t)
scol = scol + 1
Next
sline = sline + 1
If sline > buffs Then
Sheets("Feuil3").Range(Cells(2 + arapage, 1), Cells(2 + buffs + arapage, sizes)) = Tmpsp
sline = 1
pging = pging + 1
arapage = pging * buffs
ReDim Tmpsp(buffs, sizes)
End If
'//////////////2222222222
                End If
                End If
            End If
        End If
    End If
Next
'//////////////////111111111
Next
End With
If sline > 1 Then
Sheets("Feuil3").Range(Cells(2 + arapage, 1), Cells(2 + buffs + arapage, sizes)) = Tmpsp
End If
With Application
      .ScreenUpdating = True
      .EnableEvents = True
End With
 
Unload Me
MsgBox ("Veuillez masquer la Feuil3 en cliquant sur le logo de droite à la fin de cette opération!")
 
End Sub
 
Private Sub Valider_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    TextBox1.Text = "Attention!En cliquant sur ce bouton vous allez éditer les tests de sécurités dont vous avez sélectionnés les conditions precedemment. "
        TextBox1.Visible = True
        TextBox2.Text = "Etape 6 "
        TextBox2.Visible = True
        Valider.BackColor = &HFF0000
        Valider.ForeColor = &HFFFFFF
End Sub
 
Private Sub CommandButton2_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    TextBox1.Text = "Attention!En cliquant sur ce bouton vous décidez de fermé la boite de dialogue. "
        TextBox1.Visible = True
        CommandButton2.BackColor = &HFF0000
        CommandButton2.ForeColor = &HFFFFFF
End Sub

Si j'ai bien compris voici le code pour le userform « Unité à l’arrêt » vous avez utiliser un argot que je n'ai pas compris "Activé ou tester" il fallait dire simplement quelles sont les colonne qui seront editees et par quelle valeurs
voir le commentaire dans Sub Valider_Click()
Dans le troisième je voudrais filtrer par rapport au combox1 et 2

dans ce code ja' supprimer toutes les mouse move.

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
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
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
 
Option Explicit
Public data As Variant
Public counts As Long
Private Sub SetList(slist As Object, ParamArray params() As Variant)
Dim oCollection As New Collection, stmps As String
Dim j, sRow, zt, tp, paramid, b, Refs As Long, elements, elem As Variant
Dim setfind As Boolean
slist.Clear
sRow = Feuil4.Range("W" & Rows.Count).End(xlUp).Row
Refs = 50
setfind = True
paramid = UBound(params)
ReDim Tableau(Refs)
For b = 1 To sRow Step Refs
Tableau = Feuil4.Range("W1:Z" & Refs).Offset(b, 0).Value
For zt = 1 To Refs
setfind = True
For tp = 1 To paramid
If (params(tp) <> Trim(Tableau(zt, tp))) Then
setfind = False
Exit For
End If
Next
If setfind Then
stmps = Trim(Tableau(zt, paramid + 1))
If stmps <> "" Then
On Error Resume Next
oCollection.Add stmps, CStr(stmps)
Err.Clear
End If
End If
Next
Next
If oCollection.Count > 0 Then
ReDim ss(oCollection.Count - 1, 0): j = 0
For Each elem In oCollection
ss(j, 0) = elem: j = j + 1
Next
slist.List = ss
End If
End Sub
Private Sub ListEdit(slist As Object, ParamArray params() As Variant)
Dim oCollection As New Collection, stmps As String
Dim j, sRow, zt, tp, n, paramid, b, Refs As Long, elements, elem As Variant
Dim setfind As Boolean
slist.Clear
sRow = Feuil4.Range("W" & Rows.Count).End(xlUp).Row
Refs = 50
counts = 0
ReDim data(1, 10)
setfind = True
paramid = UBound(params)
ReDim Tableau(Refs)
For b = 1 To sRow Step Refs
Tableau = Feuil4.Range("W1:Z" & Refs).Offset(b, 0).Value
For zt = 1 To Refs
setfind = True
For tp = 1 To paramid
If (params(tp) <> Trim(Tableau(zt, tp))) Then
setfind = False
Exit For
End If
Next
If setfind Then
stmps = Trim(Tableau(zt, paramid + 1))
If stmps <> "" Then
data(0, counts) = stmps
data(1, counts) = b + zt
counts = counts + 1
If counts > 10 Then
ReDim Preserve data(1, counts + 10)
End If
On Error Resume Next
oCollection.Add stmps, CStr(stmps)
Err.Clear
End If
End If
Next
Next
If oCollection.Count > 0 Then
ReDim ss(oCollection.Count - 1, 0): j = 0
For Each elem In oCollection
ss(j, 0) = elem: j = j + 1
Next
slist.List = ss
End If
End Sub
Private Sub Command_Ajout_Click()
    Module4.Ajout_Liste
End Sub
Private Sub Command_Aucune_Click()
    Module4.Aucune
End Sub
Private Sub Command_Supp_Click()
    Module4.Suppr_Liste
End Sub
 
Private Sub Command_Toutes_Click()
    Module4.Toutes
End Sub
Private Sub Liste1_Click()
    Module4.Bouton
End Sub
Private Sub Liste2_Click()
  Module4.Bouton
End Sub
Private Sub CommandButton7_Click()
Listes.Hide
End Sub
Private Sub UserForm_Initialize()
Call SetList(ComBox1, "")
End Sub
Private Sub ComBox1_Change()
ComBox2.Clear
Call SetList(ComBox2, "", ComBox1.Value)
ComBox2_Change
End Sub
Private Sub ComBox2_Change()
ComBox3.Clear
Call SetList(ComBox3, "", ComBox1.Value, ComBox2.Value)
ComBox3_Change
End Sub
Private Sub ComBox3_Change()
Call ListEdit(Liste1, "", ComBox1.Value, ComBox2.Value, ComBox3.Value)
End Sub
Private Sub Annuler_click()
    Listes.Hide
End Sub
Private Sub Valider_Click()
Dim i, j As Long
With Sheets("Feuil4")
'je ne sais pas quelle est la ou les colonnes qui seront modifiées pour "Activé ou tester" alors j'ai choisi une  21ème colonne ou "Marche"
    For i = 0 To Liste2.ListCount - 1
        For j = 0 To counts - 1
        If (Liste2.List(i) = data(0, j)) Then
           .Cells(data(1, j), 21) = "oui" ' 21 est le numéro de la colonne "Marche" tu vas le modifier a votre guise
           .Cells(data(1, j), 20) = "X"   '20 est le numéro de la colonne "Arrêt" tu vas le modifier a votre guise si tu veux inclure ça dans opération
         End If
        Next
      Next
   End With
End Sub

programme avec plein de défaut

salut,

oui pour l'userform1 "editer les tests de sécurité sa marche comme sur des roulettes,

mais j'ai plus de Pb à faire marcher le second userform2 "unité partiellement à l'arrêt.

J'ai deja evoque ca pour resoudre le probleme initiale sur cette discution
tu ne pe pas utiliser le cle comme ça si il y a un mot qui existe deja va produire une erreur
Code:

1 2 Colect2.Add .Cells(i, ColB).Text, CStr(.Cells(i, ColB))
voici le bon
Code:

1 2 3 4 On Error Resume Next Colect2.Add .Cells(i, ColB).Text, CStr(.Cells(i, ColB)) Err.Clear
il faut citer le probleme

Cette procedure code utilise le tableaux data() tu vas l'essayer avec le code que j'ai envoye mais je n'ai pas optimiser la vitesse d'execution

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
28
 
Private Sub Valider_Click()
Dim i, j, incr As Long, acRange As Range
Set acRange = Sheets("Feuil3").Range("A2")
incr = 2
Sheets("Feuil3").Range(acRange.Address, "IV" & Rows.Count).ClearContents
Application.Goto acRange
With Application
        .ScreenUpdating = False
        .EnableEvents = False
End With
With Sheets("Feuil4")
For i = 0 To Liste2.ListCount - 1
        For j = 0 To counts - 1
        If (Liste2.List(i) = data(0, j)) Then
 
Sheets("Feuil3").Range("A" & incr & ":B" & incr).Value = .Range("E" & data(1, j) & ":F" & data(1, j)).Value
Sheets("Feuil3").Range("C" & incr & ":K" & incr).Value = .Range("K" & data(1, j) & ":S" & data(1, j)).Value
incr = incr + 1
End If
        Next
      Next
   End With
   With Application
      .ScreenUpdating = True
      .EnableEvents = True
End With
End Sub