Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Supprimer item listbox multiselection

KTM

XLDnaute Impliqué
Salut chers tous
je voudrais savoir comment selectionner une ligne dans ma listbox , la supprimer ainsi que l'enregistrement correspondant dans ma base de données.
ma base comporte une ligne entête.
Merci
 

Robert

XLDnaute Barbatruc
Repose en paix
Bonjour 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
 

BOISGONTIER

XLDnaute Barbatruc
Repose en paix
Bonjour,

Si la ListBox est triée, le rang de la ListBox n'est pas le no d'enregistrement et s'il n'y a pas de clé pour FIND.

Code:
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



Boisgontier
 

Pièces jointes

  • FormRemoveItem2.xls
    77 KB · Affichages: 16
Dernière édition:

KTM

XLDnaute Impliqué
Robert
J'ai essayé d'adapter mais ça coince
Je vous joins un fichier test pour illustrer ma preoccupation
 

Pièces jointes

  • suppr Enrg depuis listbox.xls
    61.5 KB · Affichages: 10

JM27

XLDnaute Barbatruc
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).
 

Pièces jointes

  • suppr Enrg depuis listbox1.xls
    67.5 KB · Affichages: 11
Dernière édition:

BOISGONTIER

XLDnaute Barbatruc
Repose en paix
Bonjour,

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
 

Pièces jointes

  • Copie de suppr Enrg depuis listbox.xls
    57 KB · Affichages: 10

job75

XLDnaute Barbatruc
Bonjour 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) :
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
    Columns(7).ClearContents 'RAZ
    .Rows(1).Delete
    If .[A1] <> "" Then ListBox1.RowSource = .[A1].CurrentRegion.Address(External:=True)
End With
Application.ScreenUpdating = True
End Sub
Le fichier en retour.

Edit : ajouté Columns(7).ClearContents 'RAZ

Bonne journée.
 

Pièces jointes

  • suppr Enrg depuis listbox(1).xls
    96.5 KB · Affichages: 12
Dernière édition:

KTM

XLDnaute Impliqué
MERCI INFINIMENT!!!!!!!
 

KTM

XLDnaute Impliqué
j'ai essayé et ça marche Merci
 

KTM

XLDnaute Impliqué
C'est très clair ! Merci Et surtout Merci pour les commentaires job75
 

Discussions similaires

Réponses
21
Affichages
2 K
Réponses
25
Affichages
1 K
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…