XL 2016 Trier par ordre alphabétique une nouvelle entrée

[micdech]

Bonjour,
J'aimerais qu'à la validation de mon formulaire, la saisie se mette automatiquement par ordre alphabétique sur ma feuille. Est-ce possible ?

Voici le code concerné :

Private Sub CommandButton1_Click()

Dim L As Integer
Dim D As Integer
Sheets("DATA Qui").Select
If MsgBox("Confirmez-vous cette saisie ?", vbYesNo, "CONFIRMEZ !") = vbYes Then
L = Sheets("DATA Qui").Range("A" & Rows.Count).End(xlUp).Row + 1
End If

MsgBox "Votre saisie est enregistrée"

Range("A" & L).Value = TextBox5
Range("B" & L).Value = TextBox1
Range("C" & L).Value = TextBox2
Range("D" & L).Value = ComboBox1
Range("E" & L).Value = TextBox3
Range("F" & L).Value = TextBox4
Range("G" & L).Value = TextBox7
Range("H" & L).Value = TextBox6

ln = fs.Range("B:B").Find(ComboBox1, lookat:=xlWhole).Row
fs.Range("G" & ln) = 0
fs.Range("F" & ln) = TextBox4

Unload UserForm2
UserForm2.Show

End Sub

Merci de m'aider.

 

[Theze]

Bonjour,

Poste un fichier exemple afin que nous n'ayons pas à en construire un !
Ton code est mal construit car si clic sur le bouton, "Non", L aura la valeur 0 et donc plantage à al première ligne qui enregistre les valeurs :

Range("A" & L).Value = TextBox5

car il n'existe pas de ligne 0 donc, plutôt comme ceci :

Private Sub CommandButton1_Click()

    Dim L As Integer
    Dim D As Integer
  
    Sheets("DATA Qui").Select
  
    If MsgBox("Confirmez-vous cette saisie ?", vbYesNo, "CONFIRMEZ !") = vbNo Then Exit Sub
  
    L = Sheets("DATA Qui").Range("A" & Rows.Count).End(xlUp).Row + 1
  
    Range("A" & L).Value = TextBox5.Text
    Range("B" & L).Value = TextBox1.Text
    Range("C" & L).Value = TextBox2.Text
    Range("D" & L).Value = ComboBox1.Text
    Range("E" & L).Value = TextBox3.Text
    Range("F" & L).Value = TextBox4.Text
    Range("G" & L).Value = TextBox7.Text
    Range("H" & L).Value = TextBox6.Text
  
    Ln = fs.Range("B:B").Find(ComboBox1, lookat:=xlWhole).Row
    fs.Range("G" & Ln) = 0
    fs.Range("F" & Ln) = TextBox4.Text
  
    MsgBox "Votre saisie a été enregistrée"
  
    Unload UserForm2
    UserForm2.Show
End Sub

Même si Text est la propriété par défaut il est recommandé de la préciser malgré tout car dans certaines circonstances il peut y avoir des bugs qui peuvent être difficile à dénicher !

 

[micdech]

Merci de ta réponse Theze.

Je mets mon fichier pas anonyme mais c'est pas grave.
En cliquant sur "Afficher les feuilles" tu peux accéder au classeur avec le code : **********
Si tu aperçois d'autres incohérences ne te gêne pas de les corriger ou de me les signaler.

Merci beaucoup de ton aide.

 

[Theze]

Bonjour,

Désolé pour le retard absent depuis deux jours. voici le code à mettre à la place du code du bouton. Il y a une fonction pour définir la plage afin de la trier :

Private Sub CommandButton1_Click()
   
    Dim Plage As Range
    Dim L As Integer
    Dim D As Integer
    Sheets("DATA Qui").Select
    If MsgBox("Confirmez-vous cette saisie ?", vbYesNo, "CONFIRMEZ !") = vbNo Then Exit Sub
    L = Sheets("DATA Qui").Range("A" & Rows.Count).End(xlUp).Row + 1
    Range("A" & L).Value = TextBox5.Text
    Range("B" & L).Value = TextBox1.Text
    Range("C" & L).Value = TextBox2.Text
    Range("D" & L).Value = ComboBox1.Text
    Range("E" & L).Value = TextBox3.Text
    Range("F" & L).Value = TextBox4.Text
    Range("G" & L).Value = TextBox7.Text
    Range("H" & L).Value = TextBox6.Text
    ln = fs.Range("B:B").Find(ComboBox1, lookat:=xlWhole).Row
    fs.Range("G" & ln) = 0
    fs.Range("F" & ln) = TextBox4.Text
   
    Set Plage = DefPlage(Sheets("DATA Qui"), 2, 1)
   
    Plage.Sort Plage(1, 2), xlAscending
   
    MsgBox "Votre saisie a été enregistrée"
    Unload UserForm2
    UserForm2.Show
   
End Sub
Function DefPlage(Fe As Worksheet, Optional L As Long = 1, Optional C As Long = 1) As Range
   
    On Error GoTo Fin
   
    With Fe
        Set DefPlage = .Range(.Cells(L, C), _
                       .Cells(.Cells.Find("*", .[A1], -4123, , _
                       1, 2).Row, .Cells.Find("*", .[A1], -4123, , _
                       2, 2).Column))
    End With
   
    Exit Function
   
Fin:
    Set DefPlage = Nothing
End Function

 

[micdech]

Pour Theze !

Merci infiniment d'avoir pris de ton temps pour solutionner mon souci.
Ça fonctionne parfaitement.
Bonne journée et à bientôt j'espère.

 

[Theze]

Bonjour,

Content de t'avoir aidé