Boostez vos compétences Excel avec notre communauté !
Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force.
Apprenez, échangez, progressez – et tout ça gratuitement !
👉 Inscrivez-vous maintenant !
Après plusieurs essais, je n'arrive pas à adapter une macro pour effacer complétement une ligne.
Dans un userform, je recherche une fiche et fait apparaitre tous les renseignements dans les champs. Ce que je souhaite réaliser, c'est lorsque je clique sur la chechbox qui me permet de faire apparaître le bouton Supprimer, que celui-ci ne soit valide que si un nom est présent dans la Textbox1 et qu'ensuite après validation sur le bouton supprimer, j'ai la ligne correspondant à la fiche affichée soit effacée du tableau.
ci joint le fichier ici : Cijoint.fr - Service gratuit de dépôt de fichiers
Ici les macros me posant problème :
Code:
Private Sub CommandButton4_Click()
Dim L As Integer
Dim Plage As Range
Dim Cell As Range
Dim Msg As Integer
Dim Nom As String
Dim Prenom As String
With ActiveSheet
.Unprotect
L = Sheets("2010").Range("A65536").End(xlUp).Row
Set Plage = Sheets("2010").Range("A2:AT" & L)
Nom = TextBox1.Value
Prenom = TextBox2.Value
If Nom = "" Then Exit Sub
For Each Cell In Plage
If Cell.Value = Nom Then
Msg = MsgBox("Voulez-Vous Supprimer : " & Nom & " " & Prenom, vbYesNo, "Patrick pour le SSF")
If Msg = 6 Then
Cell.Value = ""
Feuil2.Range("A2:A" & Feuil2.[A65536].End(3).Row).Delete
Ini
Combo
Else: Exit Sub
Combo
End If
Else
Combo
End If
Next Cell
Combo
.Protect
End With
End Sub
-----------------------------------------
Private Sub Combo()
With TextBox1
.Value = ""
.SetFocus
End With
End Sub
---------------------------------------
Private Sub Ini()
Dim L As Integer
Dim Plage As String
L = Sheets("2010").Range("A65536").End(xlUp).Row
Plage = Sheets("2010").Range("A2:A" & L).Address
Label2.RowSource = "2010" & Plage
End Sub
Je pense qu'en modifiant ton code comme suit, tu devrais obtenir le résultat escompé.
Par contre, la macro Ini qui se produit après l'effacement de la ligne provoque une erreur.
Code:
Private Sub CommandButton4_Click()
Dim L As Integer
Dim Plage As Range
Dim Cell As Range
Dim Msg As Integer
Dim Nom As String
Dim Prenom As String
With ActiveSheet
.Unprotect
L = Sheets("2010").Range("A65536").End(xlUp).Row
Set Plage = Sheets("2010").Range("A2:AT" & L)
Nom = TextBox1.Value
Prenom = TextBox2.Value
If Nom = "" Then Exit Sub
For Each Cell In Plage
If Cell.Value = Nom Then
Msg = MsgBox("Voulez-Vous Supprimer : " & Nom & " " & Prenom, vbYesNo, "Patrick pour le SSF")
If Msg = 6 Then
[COLOR="Blue"][B]Feuil2.Range("A" & Cell.Row).EntireRow.Delete[/B][/COLOR]
Ini
Combo
Else: Exit Sub
Combo
End If
Else
Combo
End If
Next Cell
Combo
.Protect
End With
End Sub
Mais je viens de m'apercevoir que dans ma colonne A, cela me faisait un trou dans mes numeros ex: 7, 8, 10, 11...🙁
Y aurait-il un moyen pour qu'à l'éffacement d'une ligne, cela me recalcule les numéros afin de les avoir tous à la suite, sachant qu'au prochain ajout, cela me prend le dernier numéro +1.😕
Désolé mais ce n'est pas ce que je recherche à faire (Il n'enlève pas le dernier numéro en A)
Ce que je souhaite c'est numéroter par ordre croissant ma liste de manière à ce que le dernier numéro correspond au dernier nom. De plus lorsque je vais intégrer un nouveau nom, il devra se classer par ordre alphabétique.
Le numéro en colone A est plus pour effectuer une recherche rapide sur papier (très utile par moment) et en plus il me sert surtout pour récupérer les données de cette liste dans un autre application.
Mais je viens de m'apercevoir que dans ma colonne A, cela me faisait un trou dans mes numeros ex: 7, 8, 10, 11...🙁
Y aurait-il un moyen pour qu'à l'éffacement d'une ligne, cela me recalcule les numéros afin de les avoir tous à la suite, sachant qu'au prochain ajout, cela me prend le dernier numéro +1.😕
Pour répondre à ta demande, voici comment modifier le code pour renuméroter la liste :
Code:
Private Sub CommandButton4_Click()
Dim L As Integer[COLOR="Red"][B], Lg As Integer[/B][/COLOR]
Dim Plage As Range
Dim Cell As Range
Dim Msg As Integer
Dim Nom As String
Dim Prenom As String
With ActiveSheet
.Unprotect
L = Sheets("2010").Range("A65536").End(xlUp).Row
Set Plage = Sheets("2010").Range("A2:AT" & L)
Nom = TextBox1.Value
Prenom = TextBox2.Value
If Nom = "" Then Exit Sub
For Each Cell In Sheets("2010").Range("B2:B" & L)
If Cell.Value = Nom Then
[COLOR="Red"][B]Lg = Cell.Row[/B][/COLOR]
Msg = MsgBox("Voulez-Vous Supprimer : " & Nom & " " & Prenom, vbYesNo, "Patrick pour le SSF")
If Msg = 6 Then
Feuil2.Range("A" & Cell.Row).EntireRow.Delete
[COLOR="Red"][B]For Lg = Lg To Feuil2.Range("A65536").End(xlUp)
Feuil2.Cells(Lg, 1) = Feuil2.Cells(Lg - 1, 1) + 1
Next[/B][/COLOR]
Ini
Combo
Else: Exit Sub
Combo
End If
Else
Combo
End If
Next Cell
Combo
.Protect
End With
End Sub
Toutefois, la remarque d'Excel-lent est excel-lente (bonsoir Bonsoir Excel-lent), pour ne pas dire judicieuse.
Private Sub CommandButton4_Click()
Dim L As Integer[COLOR=black], Lg As Integer
[/COLOR]Dim Plage As Range
Dim Cell As Range
Dim Msg As Integer
Dim Nom As String
Dim Prenom As String
With ActiveSheet
.Unprotect
L = Sheets("2010").Range("A65536").End(xlUp).Row
Set Plage = Sheets("2010").Range("A2:AT" & L)
Nom = TextBox1.Value
Prenom = TextBox2.Value
If Nom = "" Then Exit Sub
For Each Cell In Sheets("2010").Range("B2:B" & L)
If Cell.Value = Nom Then
[COLOR=black]Lg = Cell.Row
[/COLOR]Msg = MsgBox("Voulez-Vous Supprimer : " & Nom & " " & Prenom, vbYesNo, "Patrick pour le SSF")
If Msg = 6 Then
Feuil2.Range("A" & Cell.Row).EntireRow.Delete
[COLOR=black] [/COLOR][COLOR=black]For Lg = Lg To Feuil2.Range("A65536").End(xlUp)
[/COLOR][COLOR=red] [B]Feuil2.Cells(Lg, 1) = Feuil2.Cells(Lg - 1, 1) + 1
[/B] [COLOR=black]Next[/COLOR][/COLOR]
Ini
Combo
Else: Exit Sub
Combo
End If
Else
Combo
End If
Next Cell
Combo
.Protect
End With
End Sub
Actuellement je fais mon projet sous deux formes différentes, un avec une clé primaire, et le second en numérotant sans le moindre trou numérique.
En ce qui concerne la remarque de Excel-lent
Tes numéros d'ordre, figurant colonne A est ce qu'on appelle une "clé primaire" (*)
Donc normalement il ne faut surtout pas changer la numérotation, ni réutiliser les numéros déjà utilisé.
Je garde bien entendu cette idée, car il est vrai que c'est la plus simple .
Ma seconde idée, sans le moindre trou numérique, c'est que le dernier numéro correspond toujours avec le nombre de NOM et qu'en plus lorsque je vais intégrer un nouveau nom, je devrai pouvoir l'insérer dans l'ordre alphabétique.
Dans les deux cas je ne suis pas tenu à une liaison définitive Numéro et NOM car tous les ans la liste change en janvier.
Private Sub CommandButton4_Click()
Dim L As Integer[COLOR=black], [COLOR="Red"][B]Lg As Integer[/B][/COLOR]
[/COLOR]Dim Plage As Range
Dim Cell As Range
Dim Msg As Integer
Dim Nom As String
Dim Prenom As String
With ActiveSheet
.Unprotect
L = Sheets("2010").Range("A65536").End(xlUp).Row
Set Plage = Sheets("2010").Range("A2:AT" & L)
Nom = TextBox1.Value
Prenom = TextBox2.Value
If Nom = "" Then Exit Sub
For Each Cell In Sheets("2010").Range("B2:B" & L)
If Cell.Value = Nom Then
[COLOR=black]Lg = Cell.Row
[/COLOR]Msg = MsgBox("Voulez-Vous Supprimer : " & Nom & " " & Prenom, vbYesNo, "Patrick pour le SSF")
If Msg = 6 Then
Feuil2.Range("A" & Cell.Row).EntireRow.Delete
[COLOR=black] [/COLOR][COLOR=black]For Lg = Lg To Feuil2.Range("A65536").End(xlUp)
[/COLOR][COLOR=red] [B]Feuil2.Cells(Lg, 1) = Feuil2.Cells(Lg - 1, 1) + 1
[/B] [COLOR=black]Next[/COLOR][/COLOR]
Ini
Combo
Else: Exit Sub
Combo
End If
Else
Combo
End If
Next Cell
Combo
.Protect
End With
End Sub
Actuellement je fais mon projet sous deux formes différentes, un avec une clé primaire, et le second en numérotant sans le moindre trou numérique.
En ce qui concerne la remarque de Excel-lent
Je garde bien entendu cette idée, car il est vrai que c'est la plus simple .
Ma seconde idée, sans le moindre trou numérique, c'est que le dernier numéro correspond toujours avec le nombre de NOM et qu'en plus lorsque je vais intégrer un nouveau nom, je devrai pouvoir l'insérer dans l'ordre alphabétique.
Dans les deux cas je ne suis pas tenu à une liaison définitive Numéro et NOM car tous les ans la liste change en janvier.
Après plusieurs essais, je m'aperçois que si j'enlève la ligne n° 01, cela me fait bien une erreur ici :
...
...
Msg = MsgBox("Voulez-Vous Supprimer : " & Nom & " " & Prenom, vbYesNo, "Patrick pour le SSF")
If Msg = 6 Then
Feuil2.Range("A" & Cell.Row).EntireRow.Delete For Lg = Lg To Feuil2.Range("A65536").End(xlUp) Feuil2.Cells(Lg, 1) = Feuil2.Cells(Lg - 1, 1) + 1 Next
Ini
...
...
Après plusieurs essais, je m'aperçois que si j'enlève la ligne n° 01, cela me fait bien une erreur ici :
...
...
Msg = MsgBox("Voulez-Vous Supprimer : " & Nom & " " & Prenom, vbYesNo, "Patrick pour le SSF")
If Msg = 6 Then
Feuil2.Range("A" & Cell.Row).EntireRow.Delete For Lg = Lg To Feuil2.Range("A65536").End(xlUp) Feuil2.Cells(Lg, 1) = Feuil2.Cells(Lg - 1, 1) + 1 Next
Ini
...
...
Re : effectivement, si tu supprimes le premier nom, tu tombes sur la ligne d'en-tête, d'où l'erreur !
Essaies en modifiant comme ceci :
Code:
Private Sub CommandButton4_Click()
Dim L As Integer, Lg As Integer
Dim Plage As Range
Dim Cell As Range
Dim Msg As Integer
Dim Nom As String
Dim Prenom As String
With ActiveSheet
.Unprotect
L = Sheets("2010").Range("A65536").End(xlUp).Row
Set Plage = Sheets("2010").Range("A2:AT" & L)
Nom = TextBox1.Value
Prenom = TextBox2.Value
If Nom = "" Then Exit Sub
For Each Cell In Sheets("2010").Range("B2:B" & L)
If Cell.Value = Nom Then
Lg = Cell.Row
Msg = MsgBox("Voulez-Vous Supprimer : " & Nom & " " & Prenom, vbYesNo, "Patrick pour le SSF")
If Msg = 6 Then
Feuil2.Range("A" & Cell.Row).EntireRow.Delete
For Lg = Lg To Feuil2.Range("A65536").End(xlUp)
[COLOR="Red"][B]If Lg = 2 Then
Feuil2.Cells(Lg, 1) = 1
Else
Feuil2.Cells(Lg, 1) = Feuil2.Cells(Lg - 1, 1) + 1
End If[/B][/COLOR]
Next
Ini
Combo
Else: Exit Sub
Combo
End If
Else
Combo
End If
Next Cell
Combo
.Protect
End With
End Sub
- Navigue sans publicité - Accède à Cléa, notre assistante IA experte Excel... et pas que... - Profite de fonctionnalités exclusives Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel. Je deviens Supporter XLD