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
| Option Explicit
Option Base 1
Option Compare Text
Public aa
Public mem1 As Boolean
Private O1 As Object
Private Sub UserForm_Initialize()
C3.Visible = 0: C4.Visible = 0
End Sub
Private Sub C3_Click()
Dim rep, memo$
If ListBox1.ListIndex = -1 Then Exit Sub
rep = MsgBox("Attention Voulez vous rééllement supprimer la ligne sélectionnée??", vbYesNo, "Suppression de ligne")
If rep = vbNo Then Exit Sub
memo = T1
Worksheets("MATRICE").Rows(ListBox1.List(ListBox1.ListIndex, 4)).Delete
Unload Resultat
Resultat.T1 = memo
Resultat.Show
End Sub
Private Sub C4_Click()
Dim LI As Integer 'déclare la variable LI (LIgne)
Dim I As Byte 'déclare la variable I (Incrément)
Dim memo$
If Me.ListBox1.ListIndex = -1 Then Exit Sub 'si aucun élément de la ListBox1 n'est sélectionné, sort de la procédure
LI = ListBox1.List(ListBox1.ListIndex) 'récupère le numéro de lígne de l'élément sélectionné
For I = 1 To 6 'boucle sur les 6 TextBoxes
'renvoie dans l'onglet O1 en cellule ligne LI, colonne I, la valeur de la TextBox I+2 et efface son contenu
Worksheets("MATRICE").Cells(LI, I).Value = Me.Controls("T" & I + 1): Me.Controls("T" & I + 1).Value = ""
Next I 'prochaine TextBox de la boucle
memo = T1
Unload Resultat
Resultat.T1 = memo
Resultat.Show
End Sub
Private Sub CommandButton1_Click()
T1 = "": C3.Visible = 0: C4.Visible = 0
End Sub
Private Sub CommandButton2_Click()
Unload Resultat
End Sub
Private Sub ListBox1_Click()
Dim I&, lig&
If ListBox1.ListIndex = -1 Then Exit Sub
For I = 1 To 5
mem1 = 1
Controls("T" & I + 1) = ListBox1.List(ListBox1.ListIndex, I - 1)
Next I
C3.Visible = 1: C4.Visible = 1
mem1 = 0
End Sub
Private Sub T1_Change()
Dim I&, fin&, y&, a&, mem As Boolean
Application.ScreenUpdating = 0
If mem1 Then Exit Sub
If T1 = "" Then ListBox1.Clear: T2 = "": T3 = "": T4 = "": T5 = "": T6 = "": C3.Visible = 0: C4.Visible = 0: Exit Sub
ListBox1.Clear
With Sheets("MATRICE")
y = 1
fin = .Range("A" & Rows.Count).End(xlUp).Row
aa = .Range("A2:F" & fin)
End With
For I = 1 To UBound(aa)
aa(I, 6) = I + 1
Next I
For I = 1 To UBound(aa)
For a = 1 To UBound(aa, 2)
If aa(I, a) Like "*" & T1 & "*" Then aa(I, 6) = "oui": y = y + 1: Exit For
Next a
Next I
If y = 1 Then Exit Sub
If y = 2 Then
For I = 1 To UBound(aa)
If aa(I, 6) = "oui" Then
ListBox1.AddItem aa(I, 1)
For a = 1 To UBound(aa, 2) - 2
ListBox1.List(ListBox1.ListCount - 1, a - 1) = aa(I, a)
Controls("T" & a + 1) = aa(I, a)
Next a
mem = 1: Exit For
End If
Next I
Else
ReDim bb(y - 1, UBound(aa, 2) - 1)
y = 1
For I = 1 To UBound(aa)
If aa(I, 6) = "oui" Then
For a = 1 To UBound(aa, 2) - 1
bb(y, a) = aa(I, a)
Next a
y = y + 1
End If
Next I
End If
With ListBox1
.ColumnCount = 5
.ColumnWidths = "80;80;150;80;50"
If mem Then Exit Sub
.List = bb
End With
End Sub
Private Sub UserForm_Click()
End Sub |
Partager