Effacer lignes de la liste source d'un listbox

Version imprimable

Bonjour à tous,
Tout débutant en VBA, j'ai beau regarder dans tous les forums, je ne trouve pas la réponse à ma quesiton...
Je vous explique... Je cherche à monter un dossier médical informatisé...
entre autres, j'ai une feuille "dossier médical" et une feuille "Dossier IDE"
Je souhaite pourvoir faire des prescriptions sur le dossier médical, via checkbo et menus déroulants.
Le différentes prescriptions vont se mettre dans une feuille "Taches" qui sera masquée et qui sert de rowsource a une userform avec listbox
Une fois certains ou tous les items de cette listbox selectionnes, je souhaite qu'ils aillent s'afficher dans la colonne "faits" du dossier IDE... jusque la c'est bon.
C'est la que mon probleme intervient. Une fois que les prescriptions sont executées, j'aimerais pourvoir les effacer de la rowsource, pour qu'ils ne s'affichent pas de nouveau a l'ouverture suivante du userform "prescription"....
et la ca coince....
Je vous laisse le code que j'ai écrit...
merci d'avance!
Code:

1 2 3 4 5 6 7 8 Private Sub UserForm_Initialize() Dim listetaches As String Dim lig As Long lig = Sheets("Taches").Range("A65535").End(xlUp).Row listetaches = "Taches!A2:A" & lig ListBox1.RowSource = listetaches End Sub
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 Private Sub CommandButton1_Click() Dim i As Integer Dim ligtache As Long Dim ligne As String ligne = ListBox1.ListIndex On Error Resume Next For i = 0 To ListBox1.ListCount - 1 If ListBox1.Selected(i) = True Then If Range("J11") = "" Then ligtache = Sheets("Dossier IDE").Range("J65535").End(xlUp).Row + 2 Else ligtache = Sheets("Dossier IDE").Range("J65535").End(xlUp).Row + 1 End If With Sheets("Dossier IDE") Sheets("Dossier IDE").Range("J" & ligtache) = ListBox1.List(i) End With End If Next i Unload Me End Sub Private Sub CommandButton2_Click() Unload Me End Sub

Bonjour,

Il ne faut pas utiliser "RowSource", mais plus "AddItem", ce qui te permet d'utiliser "RemoveItem" pour les suppressions :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 Private Sub UserForm_Initialize() Dim listetaches As String Dim lig As Long, C As Range lig = Sheets("Taches").Range("A65535").End(xlUp).Row listetaches = "Taches!A2:A" & lig 'ListBox1.RowSource = listetaches For Each C In Range(listetaches) Me.ListBox1.AddItem C.Value Next C End Sub
Pour supprimer ce qui a été choisi:

Code:

Me.ListBox1.RemoveItem Me.ListBox1.ListIndex

28/09/2012, 21h31
Philippe Tulliez

Bonjour,
Une autre solution est d'effacer la plage listetaches

Code:

listetaches.ClearContents
30/09/2012, 09h37
Rom540000

Re bonjour a tous!

Merci messieurs pour vos réponses mais:
- je ne veux pas supprimer toute la liste source mais uniquement supprimer de cette liste les items qui auront été sélectionnés dans la listbox
- la solution de removeitem fonctionne sur la listbox mais pas sur la liste source!

Auriez vous d'autres solutions?
Merci d'avance!

Bonjour,

Essaie :

Code:

1
2
3
Private Sub ListBox1_Click()
    [Taches!A2].Offset(Me.ListBox1.ListIndex).Delete
    End Sub

30/09/2012, 17h25
gFZT82

1 pièce(s) jointe(s)

Bonjour,

Si tu autorises des sélections multiples, tu as intérêt à réaliser les opérations en 3 temps :
1) Tu mémorises l’emplacement des lignes de la ListBox sélectionnées (tableau intermédiaire),
2) Tu renseignes la feuille "Dossier IDE" avec les prescriptions sélectionnées,
3) tu supprimes les lignes correspondant aux prescriptions sélectionnées dans la liste source.

Cordialement.
15/10/2012, 14h59
Rom540000

Merci beaucoup! Je vais essayer ca!
Je ne comprends pas le code, mais si ca marche... ;)
Je vous tiens au courant!
25/08/2017, 16h51
odilolo11

cherche un nom sur listbox et supprimer en VBA
Citation:
Envoyé par Daniel.C

Bonjour,

Essaie :

Code:

1 2 3 Private Sub ListBox1_Click() [Taches!A2].Offset(Me.ListBox1.ListIndex).Delete End Sub
bonjour,

comment cherche un nom sur un listbox à l'aide d'un textbox et supprime sa ligne entière dans BD

merci

1 pièce(s) jointe(s)

Bonjour,

Exemple en PJ

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
 
Dim f, f2
Private Sub UserForm_Initialize()
  Set f = Sheets("Tâches")
  Set f2 = Sheets("Tâches")
  Me.Source.List = f.Range("A2:B" & f.[A65000].End(xlUp).Row).Value2
  Me.Source.MultiSelect = fmMultiSelectMulti
  If [E3] <> "" Then
     Me.Dest.List = f.Range("e2:f" & f.[e65000].End(xlUp).Row).Value2
     Me.Dest.MultiSelect = 0
  End If
End Sub
 
Private Sub b_prend_Click()
  If Me.Source.ListIndex <> -1 And Me.Source.ListCount > 0 Then
    For i = 0 To Me.Source.ListCount - 1
    If Me.Source.Selected(i) = True Then
       Me.Dest.AddItem Me.Source.List(i)
       pos = Me.Dest.ListCount - 1
       Me.Dest.List(pos, 1) = Me.Source.List(i, 1)
    End If
   Next i
   For i = Me.Source.ListCount - 1 To 0 Step -1
    If Me.Source.Selected(i) = True Then Me.Source.RemoveItem i
   Next i
  End If
End Sub
 
Private Sub B_enlève_Click()
  If Me.Dest.ListCount > 0 And Me.Dest.ListIndex <> -1 Then
    Me.Source.AddItem Me.Dest
    pos = Me.Source.ListCount - 1
    Me.Source.List(pos, 1) = Me.Dest.Column(1)
    Me.Dest.RemoveItem Me.Dest.ListIndex
  End If
End Sub
 
Private Sub B_transfert_Click()
  f2.[e2:f1000].ClearContents
  f2.[e65000].End(xlUp).Offset(1).Resize(Me.Dest.ListCount, 2).Value2 = Me.Dest.List
  f2.[A2:B1000].ClearContents
  f2.[A2].Resize(Me.Source.ListCount, 2).Value2 = Me.Source.List
End Sub

Boisgontier
http://boisgontierjacques.free.fr

Bonjour
Lorsque l'on travaille (ce que j'approuve personnellement) sur une listbox liée (par RowSource), on profite de tous les avantages de cette liaison.
Tu veux quoi finalement ? coller dans une autre feuille des lignes d'une feuille correspondant aux articles sélectionnés dans ta listbox et supprimer ces lignes de la feuille de liaison ?
Cela revient à :
Parcourir dans une boucle for i = 0 to listbox1.listcount-1)les élements de la listbox et, pour chaque élément sélectionné, le mettre dans un objet range (appelons-le plage) constitué ainsi (à main levée) :
Code:

1 2 3 4 5 6 7 8 9 dim plage as range with worksheets(" .... nom de la feuille source ... ") deb = deb = .range(listbox1.rowsource).row If plage is nothing then set plage = .rows(i + deb) else set plage = union(plage, .rows(i + deb) end if end with
Voilà -->> tu te trouves maintenant en possession d'une plage de ta feuille source correspondant à ce que tu as sélectionné dans la listbox.
Qu'en faire ? --->>
Tu vérifies que plage a bien été constituée (que tu as sélectionné au moins un article --->> tu quittes la sub dans le cas contraire --->>

Code:

if plage is nothing then exit sub

puis (elle n'est donc pas nothing)
1) tu la copies dans la feuille de destination à partir de la cellule de ton choix -->>>

Code:

plage.copy destination:= worksheets("... nom de la feuille de destination ...).range(...adresse de la cellule de début ...)

et
2) tu la supprimes de la feuille source

Code:

plage.entirerow.delete

Voilà. C'est tout. Et tu verras que ta listbox est elle également mise à jour (puisque liée).
Je te laisse maintenant écrire cela dans ton projet en adaptant les noms ... et en corrigeant au besoin un oubli toujours possible de ma part (code écrit à main levée).

EDIT : ceci ayant été dit , ce que j'ai exposé est général et ne répond pas à la manière de localiser dans une listbox une valeur spécifique. Et ce dernier aspect, hors sujet dans la présente discussion, devrait faire l'objet d'une discussion distincte.

1 pièce(s) jointe(s)

Citation:
Envoyé par boisgontierjacques
Bonjour,

Exemple en PJ
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 Dim f, f2 Private Sub UserForm_Initialize() Set f = Sheets("Tâches") Set f2 = Sheets("Tâches") Me.Source.List = f.Range("A2:B" & f.[A65000].End(xlUp).Row).Value2 Me.Source.MultiSelect = fmMultiSelectMulti If [E3] <> "" Then Me.Dest.List = f.Range("e2:f" & f.[e65000].End(xlUp).Row).Value2 Me.Dest.MultiSelect = 0 End If End Sub Private Sub b_prend_Click() If Me.Source.ListIndex <> -1 And Me.Source.ListCount > 0 Then For i = 0 To Me.Source.ListCount - 1 If Me.Source.Selected(i) = True Then Me.Dest.AddItem Me.Source.List(i) pos = Me.Dest.ListCount - 1 Me.Dest.List(pos, 1) = Me.Source.List(i, 1) End If Next i For i = Me.Source.ListCount - 1 To 0 Step -1 If Me.Source.Selected(i) = True Then Me.Source.RemoveItem i Next i End If End Sub Private Sub B_enlève_Click() If Me.Dest.ListCount > 0 And Me.Dest.ListIndex <> -1 Then Me.Source.AddItem Me.Dest pos = Me.Source.ListCount - 1 Me.Source.List(pos, 1) = Me.Dest.Column(1) Me.Dest.RemoveItem Me.Dest.ListIndex End If End Sub Private Sub B_transfert_Click() f2.[e2:f1000].ClearContents f2.[e65000].End(xlUp).Offset(1).Resize(Me.Dest.ListCount, 2).Value2 = Me.Dest.List f2.[A2:B1000].ClearContents f2.[A2].Resize(Me.Source.ListCount, 2).Value2 = Me.Source.List End Sub
Boisgontier
http://boisgontierjacques.free.fr
Bonjour,

Grand merci boisgontierjacques pour votre réponse car ça m’intéresse beaucoup et m'enrichir.
Par contre, ça ne résouds pas mon problème

Je demande de chercher dans un textbox un contact et ce nom affiche sur un listbox.
Je fait un double click sur la listbox, un userform s'affiche
je click sur le bouton modifier pour modifier la contenu ou pour supprimer ce contact dans BD. Si je modifie ou supprime ce contact, d'autre contact a été supprimé mais c'est pas il

NB: si je change directement sur la listbox sans allez sur textbox, ça marche; mais si j'utilise le textbox pour la recherché, d'autre contact s'efface à la place

vous trouverez ci-joint le fichier

28/08/2017, 13h44
boisgontierjacques

1 pièce(s) jointe(s)

Bonjour,

Une autre approche

Boisgontier
http://boisgontierjacques.free.fr
29/08/2017, 07h16
odilolo11

Citation:

Envoyé par boisgontierjacques

Bonjour,

Une autre approche

Boisgontier
http://boisgontierjacques.free.fr

Bonjour Boisgontier,

je vous remercie infiniment, ça marche très bien et m'aide beaucoup

d'après votre site que j'ai approfondie mes connaissances en excel, merci, merci

cordialement,

Odilon