Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim O As Worksheet
Dim R As Range
Set O = Worksheets("Feuil1")
Set R = O.Columns(1).Find(Me.ListBox1.Value, , xlValues, xlWhole)
If Not R Is Nothing Then
O.Rows(R.Row).Delete
Me.ListBox1.RemoveItem (Me.ListBox1.ListIndex)
End If
Unload Me
UserForm1.Show
End Sub
Option Compare Text
Dim f
Private Sub UserForm_Initialize()
Set f = Sheets("BD")
Set Rng = f.Range("A2:E" & f.[A65000].End(xlUp).Row)
NbCol = Rng.Columns.Count
a = Rng.Resize(, NbCol + 1).Value ' tableau a(n,1) pour rapidité
For i = 1 To UBound(a): a(i, 6) = i + 1: Next i
TriMultiCol a, 1, 1, UBound(a)
Me.ListBox1.List = a
End Sub
Private Sub ListBox1_Click()
For i = 1 To 5: Me("textbox" & i) = Me.ListBox1.Column(i - 1): Next i
Me.Enreg = Me.ListBox1.Column(5)
End Sub
Private Sub B_sup_Click()
If MsgBox("Etes vous sûr de supprimer " & Me.TextBox1 & "?", vbYesNo) = vbYes Then
If Me.ListBox1.ListIndex = -1 Then Exit Sub
p = Me.ListBox1.Column(5)
f.Rows(Me.Enreg).Delete
Me.ListBox1.RemoveItem Me.ListBox1.ListIndex
End If
End Sub
Sub TriMultiCol(a, ColTri, gauc, droi) ' Quick sort
ref = a((gauc + droi) \ 2, ColTri)
g = gauc: d = droi
Do
Do While a(g, ColTri) < ref: g = g + 1: Loop
Do While ref < a(d, ColTri): d = d - 1: Loop
If g <= d Then
For k = LBound(a, 2) To UBound(a, 2)
temp = a(g, k): a(g, k) = a(d, k): a(d, k) = temp
Next k
g = g + 1: d = d - 1
End If
Loop While g <= d
If g < droi Then Call TriMultiCol(a, ColTri, g, droi)
If gauc < d Then Call TriMultiCol(a, ColTri, gauc, d)
End Sub
RobertBonjour le fil, bonjour le forum,
peut-être comme ça (à adapter) :
VB:Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean) Dim O As Worksheet Dim R As Range Set O = Worksheets("Feuil1") Set R = O.Columns(1).Find(Me.ListBox1.Value, , xlValues, xlWhole) If Not R Is Nothing Then O.Rows(R.Row).Delete Me.ListBox1.RemoveItem (Me.ListBox1.ListIndex) End If Unload Me UserForm1.Show End Sub
Dim f
Private Sub UserForm_Initialize()
Set f = Sheets("liste")
With ListBox1
.ColumnCount = 6
.ColumnWidths = "20;20;20;20;20;20"
.MultiSelect = fmMultiSelectMulti
End With
Me.ListBox1.List = f.Range("A2:F" & f.[A65000].End(xlUp).Row)Value
End Sub
Private Sub CommandButton1_Click()
For i = Me.ListBox1.ListCount - 1 To 0 Step -1
If Me.ListBox1.Selected(i) Then f.Rows(i + 2).Delete
Next i
UserForm_Initialize
End Sub
Private Sub CommandButton1_Click() 'bouton Supprimer
Dim i&
For i = ListBox1.ListCount - 1 To 0 Step -1
If ListBox1.Selected(i) Then Rows(ListBox1.List(i, 6)).Delete
Next
ListBox1.RowSource = ""
UserForm_Initialize
End Sub
Private Sub UserForm_Initialize()
Application.ScreenUpdating = False
With ListBox1
.ColumnCount = 7
.ColumnWidths = "30;30;30;30;30;30;0" '7ème colonne masquée
.MultiSelect = fmMultiSelectMulti
End With
With Sheets("Liste")
.Cells.Delete
[A1].CurrentRegion.Columns(7) = "=ROW()" 'repérage en colonne G
Columns(7).Hidden = False 'affichage colonne G
[A1].CurrentRegion.Copy
.[A1].PasteSpecial xlPasteValues 'collage spécial-valeurs
Columns(7).Hidden = True 'masquage colonne G
Columns(7).ClearContents 'RAZ
.Rows(1).Delete
If .[A1] <> "" Then ListBox1.RowSource = .[A1].CurrentRegion.Address(External:=True)
End With
Application.ScreenUpdating = True
End Sub
MERCI INFINIMENT!!!!!!!Bonsoir
peut être comme cela
en utilisant la methode additem
Avec suppression de toutes les lignes sélectionnées
Par contre je ne comprends pas pourquoi tu mets la lisbox à multiselect alors que tu ne supprimes qu'une ligne ( Voir #1)
pour info : issue de l'aide VBA : Cette méthode ne retire pas la ligne de la liste si le contrôle ListBox est Lien supprimé (c'est-à-dire, lorsque la propriété RowSource spécifie une Lien supprimé pour le contrôle ListBox).
j'ai essayé et ça marche MerciBonjour,
La suppression est faite sur la feuille liste
VB:Dim f Private Sub UserForm_Initialize() Set f = Sheets("liste") With ListBox1 .ColumnCount = 6 .ColumnWidths = "20;20;20;20;20;20" .MultiSelect = fmMultiSelectMulti End With Me.ListBox1.List = f.Range("A2:F" & f.[A65000].End(xlUp).Row)Value End Sub Private Sub CommandButton1_Click() For i = Me.ListBox1.ListCount - 1 To 0 Step -1 If Me.ListBox1.Selected(i) Then f.Rows(i + 2).Delete Next i UserForm_Initialize End Sub
Boisgontier
C'est très clair ! Merci Et surtout Merci pour les commentaires job75Bonjour KTM, le fil, le forum,
Le fichier du post #5 utilise RowSource, on peut continuer avec cette méthode.
Simplement si l'on veut filtrer le tableau source il faut repérer les lignes.
Ici cela se fait via la colonne G (masquée) et une 7ème colonne dans la ListBox (masquée elle aussi) :
Le fichier en retour.VB:Private Sub CommandButton1_Click() 'bouton Supprimer Dim i& For i = ListBox1.ListCount - 1 To 0 Step -1 If ListBox1.Selected(i) Then Rows(ListBox1.List(i, 6)).Delete Next ListBox1.RowSource = "" UserForm_Initialize End Sub Private Sub UserForm_Initialize() Application.ScreenUpdating = False With ListBox1 .ColumnCount = 7 .ColumnWidths = "30;30;30;30;30;30;0" '7ème colonne masquée .MultiSelect = fmMultiSelectMulti End With With Sheets("Liste") .Cells.Delete [A1].CurrentRegion.Columns(7) = "=ROW()" 'repérage en colonne G Columns(7).Hidden = False 'affichage colonne G [A1].CurrentRegion.Copy .[A1].PasteSpecial xlPasteValues 'collage spécial-valeurs Columns(7).Hidden = True 'masquage colonne G .Rows(1).Delete If .[A1] <> "" Then ListBox1.RowSource = .[A1].CurrentRegion.Address(External:=True) End With Application.ScreenUpdating = True End Sub
Bonne journée.