Discussion :

[Rom540000]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

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

[Daniel.C]

Bonjour,

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

Me.ListBox1.RemoveItem Me.ListBox1.ListIndex

[Philippe Tulliez]

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

listetaches.ClearContents

[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!

[Daniel.C]

Bonjour,

Essaie :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[gFZT82]

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.

[Rom540000]

Merci beaucoup! Je vais essayer ca!
Je ne comprends pas le code, mais si ca marche...
Je vous tiens au courant!

[odilolo11]

Bonjour,

Essaie :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[boisgontierjacques]

Bonjour,

Exemple en PJ

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

[unparia]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

 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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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.

[odilolo11]

Bonjour,

Exemple en PJ

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

[boisgontierjacques]

Bonjour,

Une autre approche

Boisgontier
http://boisgontierjacques.free.fr

[odilolo11]

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