Supprimer des lignes à partir d'un USF

[Pom]

Bonsoir à tous,

J'ai créé un UseForm avec une liste de destinataires et un bouton "Supprimer".
Je sélectionne un ou plusieurs destinataires et en cliquant sur le bouton "supprimer" je veux que la ou les lignes qui correspondent aux destinataires soient supprimées. ( Les destinataires sont tous dans la colonne A, les colonnes B à F contiennent des données ).
J'ai essayé différentes façons de faire mais je n'y arrive pas ( Les boucles For i
Next, For Each Next, With ListBox1 End With ) je n'arrive pas à récupérer la sélection de la liste du UseForm.
Si quelqu'un avait une idée ?

Merci

 

[Wilfried]

Salut Pom,

Comment ce fait la selection de ton destinataire? Par ComboBox ou ListeBox Dans les deux cas tu peux récuperer le contenue de ta selection
Après :
RAnge("A1").select
activecell.end(xldown).select
der_ligne=activecell.rows
tu récupere ainsi le nb de ligne
i=0
do until i=der_ligne
if range("A1").offset(i,0).value=combobox.value then
range("A1").offset(i,0).select
range(activecell,activecell.end(xlright)).select
selection.deltree
der_ligne=der_ligne-1
else
i=i+1
end if
loop


Voila cela devait fonctionner. J'ai un doute sur deltree (syntaxe)...

A+ Wilfried ;oP

 

[Pom]

Salut Wilfried,

Je récupère les selections dans une ListBox1, La solution que tu proposes
ne fonctionne pas, elle tourne sur elle même: le sablier apparait et je suis obligé de fermer le classeur.
Avec un boucle " For i = 0 to Listbox1.ListCount " cela devrait être possible, non ?. Comment faire pour sélectionner la ou les lignes contenant la ou les cellules qui sont cochées dans la listBox et les supprimées.
Utiliser ListBox1.selected ou ListBox1.ListIndex ??
La liste des destinataires commence en A6.

Merci pour ta solution

 

[Wilfried]

RE SAlut,

Pour ma petite moulinette essaye de mettre un point d'arret dans la macro au niveau de : range(activecell,activecell.end(xlright)).select

Afin de voir où est le bug

Pour la récupération est ce que listBox1.value te revoye l'index de selection ou le texte de selection ? Si c'est l'index il faut que tu te crée un sous programme de transformation ex

public m_txt_sel as string

Public Sub transfo
select case Userform1.listbox.value
case 0 'première index
m_txt_sel="toto"
case 1
m_txt_sel="titi"
end select
end sub
etc....

Si tu te sers pour la source de ta listbox (rowsource) d'une plage de cellule utilise alors le notion de row pour connaitre le text ex

si index(0)=A6
m_txt_sel=range("A6").offset(userform1.listbox1.value,0).value

Voila.

Si cela ne marche pas envoye un petit exemple et on vérra...

A+ et bonne appétit

Wilfried ;o)

 

[Wilfried]

EUREKA...

Pour supprimé toute un ligne :

Range("A1").offset(i,0).entirerow.delete

et non deltree!!!!!

Entirerow applique à toute la ligne donc plus besoin de :

range("A1").offset(i,0).select
range(activecell,activecell.end(xlright)).select
selection.deltree

Wilfried ;o)

 

[Pom]

Re Salut,

Tu trouveras un fichier reprenant ce que je souhaite faire, j'ai réussi en partie à faire ce que je voulais avec une intruction With / End With, mais je ne peux
supprimer qu'un seul destinataire à la fois. La ListBox est en multiselect,
si tu pouvais jetter un oeil dessus et voir ce que tu peux faire pour que je puisse en supprimer plusieurs en une seule fois. Je me suis servi de la ligne de code que tu n'as donné

Range("A1").offset(i,0).entirerow.delete en l'adaptant

Merci,

A+
Pom

 

[Hervé]

bonsoir

Sans vouloir prendre la place de Wilfried.

ton problème, pom, vient du fait que tu initialise ta listbox par rowsource qui lie
la listbox à sa source (range("a5:a24"), donc lorsque tu supprimes le premier select ta listbox se réinitialise et t'efface les autres selects.

dans ton cas il vaut mieux utiliser additem pour initialiser ta listbox, problème : la listbox ne se met plus à jour après suppression, d'ou le code suivant :

Private Sub CommandButton1_Click()
Dim i As Integer
For i = ListBox1.ListCount - 1 To 0 Step -1
If ListBox1.Selected(i) = True Then
Range("a" & i + 5).EntireRow.Delete
End If
Next i
ListBox1.Clear
majlistbox1

End Sub

Sub majlistbox1()
Dim c As Range
For Each c In Range("a5:a" & Range("a65000").End(xlUp).Row)
ListBox1.AddItem c.Value
Next c
End Sub

Private Sub UserForm_Initialize()
majlistbox1
End Sub


De plus lorsque tu veux supprimer des lignes en VBA, il vaut mieux commencer par le bas et remonter.

Salut
Hervé

 

[Pom]

Salut Hervé,

L'initialisation du USF ne marchait pas en appelant "MajListBox1", et la mise
à jour dans la procédure de suppression non plus.
J'ai donc modifié le code comme suit et ca fonctionne au poil.

Private Sub UserForm_Initialize()
Dim c As Range
For Each c In Range("a5:a" & Range("a65000").End(xlUp).Row)
ListBox1.AddItem c.Value
Next c
End Sub

Private Sub CommandButton1_Click()
Dim i As Integer
For i = ListBox1.ListCount - 1 To 0 Step -1
If ListBox1.Selected(i) = True Then
Range("a" & i + 5).EntireRow.Delete

' Mise à jour de la liste

ListBox1.RemoveItem(i)
End If
Next i
End Sub

Merci à toi et à Wilfried pour votre aide

Bonnes fêtes à vous et à tous le monde

A+
Pom