Effacer des lignes d'une listbox

**Fred4345** · 11/11/2011, 17h43

J'utilise un userform qui contient 2 textbox et une listbox.
le premier textbox remplie la cellule "A" et le deuxième texbox la cellule "B" d'une même feuille.
La listbox se remplie avec les données des cellules A et B. Elle peut contenir jusqu'à 20 lignes.
Lorsque la saisie est terminé je valide avec un bouton.
Je souhaite pouvoir supprimer une ligne en cas d'erreur de saisie avant la validation finale mais je n'y arrive pas. Je vous joint le code.
Lorsqu'une ligne est rentrée je fais apparaître un bouton suppression. C'est ici que j'ai mis le code de suppression. Le code bloque à la ligne 67.

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
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
Private Sub UserForm_Initialize()
With ListBox1
     .ColumnCount = 2
     .ColumnWidths = "40"
    End With
Dim hWnd As Long
hWnd = FindWindowA("Thunder" & IIf(Application.Version Like "8*", _
"X", "D") & "Frame", Me.Caption)
SetWindowLongA hWnd, -16, GetWindowLongA(hWnd, -16) And &HFFF7FFFF
End Sub
 
Private Sub CommandButton1_Click()
Range("Essai!A1") = UCase(TextBox1)
If Range("Essai!B1").Value = "FAUX" Then MsgBox "Composant introuvable !": Exit Sub
If TextBox1.Value = "" Then MsgBox "Pas réference!": Exit Sub
If TextBox3.Value = "" Then MsgBox "Pas de quantité!": Exit Sub
If TextBox3.Value = "" Or Not IsNumeric(TextBox3.Value) Then MsgBox "Quantité non valide!": Exit Sub
Dim ShtD As Worksheet
  Set ShtD = Sheets("Ligne")
  'Récupère la dernière ligne de la feuille de données
DerLig = ShtD.Range("A65").End(xlUp).Row
' colle les valeurs
ShtD.Range("A" & DerLig + 1).Value = UCase(TextBox1.Value)
ShtD.Range("B" & DerLig + 1).Value = Me.TextBox3.Value
'ShtD.Range("C" & DerLig + 1).Value = Me.TextBox2.Value
Dim c As Range
Dim Tablo() As String
Dim text As String
Dim S As Byte
Dim firstAddress As String
Dim i As Integer, x As Integer, L As Integer
 
    'text = Me.TextBox2
    'If text = "" Then Exit Sub
 
    'For S = 1 To Worksheets.Count
        'If Worksheets(S).Name = "Ligne" Then
            'With Sheets(S).Range("A8:B40")
            'Set c = .Find(text, LookIn:=xlValues, lookat:=xlPart)
                'If Not c Is Nothing Then
                'firstAddress = c.Address
                'Do
                'ReDim Preserve Tablo(8, i)
                    'For x = 1 To 6
                        'Tablo(x - 1, i) = c.Offset(0, x - c.Column).text
                    'Next x
            'Tablo(6, i) = Sheets(S).Name
            'Tablo(7, i) = c.Address(0, 0)
            'i = i + 1
            'Set c = .FindNext(c)
            'Loop While Not c Is Nothing And c.Address <> firstAddress
        'End If
             'End With
    'End If
        'Next S
        'If i = 0 Then
        'MsgBox "La référence trouvé" & vbCrLf & "Faites un autre essai"
        'Exit Sub
        'End If
'Me.ListBox1.Column() = Tablo()
TextBox3.Value = ""
TextBox1.Value = ""
End Sub
 
Private Sub CommandButton3_Click()
Dim Lig, Col As Integer
Sheets(CStr(ListBox1.Column(6))).Activate
Range(ListBox1.Column(7)).Activate
Lig = ActiveCell.Row
Col = 1
Cells(Lig, Col).Select
Cells(Lig, 1).Value = ""
Cells(Lig, 2).Value = ""
Cells(Lig, 3).Value = ""
Cells(Lig, 4).Value = ""
Cells(Lig, 5).Value = ""
Cells(Lig, 6).Value = ""
Cells(Lig, 7).Value = ""
Cells(Lig, 8).Value = ""
Cells(Lig, 9).Value = ""
'suite
Dim c As Range
Dim Tablo() As String
Dim text As String
Dim S As Byte
Dim firstAddress As String
Dim i As Integer, x As Integer, L As Integer
 
'text = Me.TextBox2
'If text = "" Then Exit Sub
 
'For S = 1 To Worksheets.Count
'If Worksheets(S).Name = "Ligne" Then
       ' With Sheets(S).UsedRange
        'Set c = .Find(text, LookIn:=xlValues, lookat:=xlPart)
        'If Not c Is Nothing Then
        'firstAddress = c.Address
        'Do
        'ReDim Preserve Tablo(8, i)
                   ' For x = 1 To 6
                        'Tablo(x - 1, i) = c.Offset(0, x - c.Column).text
                   ' Next x
           ' Tablo(6, i) = Sheets(S).Name
            'Tablo(7, i) = c.Address(0, 0)
            'i = i + 1
        'Set c = .FindNext(c)
        'Loop While Not c Is Nothing And c.Address <> firstAddress
        'End If
        'End With
'End If
'Next S
'If i = 0 Then
'ListBox1.Visible = True
'CommandButton3.Visible = False
'Exit Sub
'End If
ListBox1.Value = ""
Me.ListBox1.Column() = Tablo()
CommandButton3.Visible = False
End Sub
 
 
Private Sub ListBox1_Click()
CommandButton3.Visible = True
End Sub
 
Private Sub UserForm_Activate()
CommandButton3.Visible = False
'TextBox2.Value = "Caisses"
End Sub

**Fred4345** · 11/11/2011, 22h50

Je suis arrivée au bout de ma recherche seul!

je donne donc ma solution. Si elle peut servir à quelqu'un d'autre!

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
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
Private Sub CommandButton3_Click()
 
Dim Lig, Col As Integer
Sheets(CStr(ListBox1.Column(6))).Activate
Range(ListBox1.Column(7)).Activate
Lig = ActiveCell.Row
Col = 1
Cells(Lig, Col).Select
Cells(Lig, 1).Value = ""
Cells(Lig, 2).Value = ""
Cells(Lig, 3).Value = ""
'Cells(Lig, 4).Value = ""
'Cells(Lig, 5).Value = ""
'Cells(Lig, 6).Value = ""
'Cells(Lig, 7).Value = ""
'Cells(Lig, 8).Value = ""
'Cells(Lig, 9).Value = ""
'suite
Dim c As Range
Dim Tablo() As String
Dim text As String
Dim S As Byte
Dim firstAddress As String
Dim i As Integer, x As Integer, L As Integer
 
text = Me.TextBox2
If text = "" Then Exit Sub
 
For S = 1 To Worksheets.Count
If Worksheets(S).Name = "Ligne" Then
       With Sheets(S).UsedRange
       Set c = .Find(text, LookIn:=xlValues, lookat:=xlPart)
        If Not c Is Nothing Then
        firstAddress = c.Address
        Do
        ReDim Preserve Tablo(8, i)
                   For x = 1 To 6
                        Tablo(x - 1, i) = c.Offset(0, x - c.Column).text
                   Next x
           Tablo(6, i) = Sheets(S).Name
            Tablo(7, i) = c.Address(0, 0)
            i = i + 1
        Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstAddress
        End If
        End With
End If
Next S
If i = 0 Then
ListBox1.Visible = True
CommandButton3.Visible = False
Exit Sub
End If
ListBox1.Value = ""
Me.ListBox1.Column() = Tablo()
CommandButton3.Visible = False
End Sub
 
 
Private Sub ListBox1_Click()
CommandButton3.Visible = True
End Sub
 
Private Sub UserForm_Activate()
CommandButton3.Visible = False
TextBox2.Value = "Caisses"
End Sub

Effacer des lignes d'une listbox [XL-2007]

Macros et VBA Excel

Discussions similaires

Partager

Partager