placer un nom à sa place dans une liste (alphabétiquement)

charette63

XLDnaute Occasionnel
bonjour à toutes et tous,

j'ai créé avec l'aide de l'éditeur, une macro permettant d'inserer un nom dans une liste, mais pour ce faire, j'entre dans un textbox de la userform le numéro de la ligne dans laquelle je veux que le nom s'inscrive. J'aimerai que le nom et prénom prennent leur place automatiquement. Une seconde macro me permet de supprimer un nom, le tableau ayant toujours le m^me nombre de lignes, le nom supprimé est remplacer par un terme (ici "remplacement) suivi d'un numero. Ce que j'aimerais, c'est que le numéro s'inscrive automatiquement.

L'adage populaire dit qu'un p'tit dessin vaut mieux qu'un long discours, je joint un fichier avec quelques explications supplémentaires

merci pour votre aide


EDIT: si vous aviez la gentillesse de placer le code sur le fil, je suis au travail, et le serveur de ma boite prend les fichiers à telecharger pour des virus (je ne sais, par consequant, les lire)

cordialement


Thierry
 

Pièces jointes

  • cut-past3.xls
    56.5 KB · Affichages: 66
Dernière édition:
C

Compte Supprimé 979

Guest
Re : placer un nom à sa place dans une liste (alphabétiquement)

Salut Charette63,

Pour ta première demande, essaye ça
VB:
Private Sub CommandButton1_Click()
  Dim ctl As Control, Dlig As Long
  For Each ctl In UserForm1.Controls
    If TypeName(ctl) = "TextBox" Then
      If ctl.Value = "" Then
        MsgBox "Vous devez remplir tous les champs !"
        Exit Sub
      End If
    End If
  Next ctl
  'Ton code ici, qui sera executé si et seulement si toutes les textbox sont remplis.
  ' Il faut enlever le texte de la colonne A
  Dlig = Range("A" & Rows.Count).End(xlUp).Row
  ' A partir de la dernière ligne remonter si le prénom est "remplacement"
  ' Et décrémenter le numéro dans la colonne B
  Do While Range("A" & Dlig).Value = "remplacement"
    On Error Resume Next
    Range("B" & Dlig).Value = Range("B" & Dlig).Value - 1
    On Error GoTo 0
    Dlig = Dlig - 1
  Loop
  ' On inscrit les valeurs à partir de la dernière ligne trouvée + 1
  Dlig = Dlig + 1
  Range("A" & Dlig).Value = TextBox2.Value
  Range("B" & Dlig).Value = TextBox3.Value
  ' On effectue un tri
  Rows("3:" & Dlig).Sort Key1:=Range("B3"), Order1:=xlAscending, _
                         Key2:=Range("A3"), Order2:=xlAscending, Header:=xlNo, OrderCustom:=1, _
                         MatchCase:=False, Orientation:=xlTopToBottom
  Range("A1").Select
  Unload Me
End Sub

A+
 
Dernière modification par un modérateur:
C

Compte Supprimé 979

Guest
Re : placer un nom à sa place dans une liste (alphabétiquement)

Re,

Pour la suppression, essaye ça
VB:
Private Sub CommandButton1_Click()
Dim ctl As Control, Dlig As Long, Lig As Long, VMax As Integer
For Each ctl In UserForm2.Controls
  If TypeName(ctl) = "TextBox" Then
    If ctl.Value = "" Then
      MsgBox "Vous devez remplir tous les champs !"
      Exit Sub
    End If
  End If
Next ctl
If Not IsNumeric(Me.TextBox1.Value) Then
  MsgBox "Vous devez inscrire un numéro de ligne !", vbCritical, "ATTENTION ..."
  Me.TextBox1.SetFocus
  Exit Sub
End If
' Récupérer le numéro de ligne et de la dernière ligne
Lig = Me.TextBox1.Value
Dlig = Range("A" & Rows.Count).End(xlUp).Row
' Inscrire les valeurs
Range("A" & Lig).Value = "remplacement"
' Calculer le nouveau numéro de remplacement
On Error Resume Next  ' Empêche Excel de s'arrêter sur une erreur
VMax = 0: VMax = Application.WorksheetFunction.Max(Range("B:b"))
On Error GoTo 0
Range("B" & Lig).Value = VMax + 1
Range("C" & Lig & ":G" & Lig).ClearContents
' Mettre la ligne à la fin
Rows(Lig & ":" & Lig).Cut Destination:=Rows(Dlig + 1)
Rows(Lig & ":" & Lig).Delete Shift:=xlUp
' Décharger l'USF
Unload Me
End Sub

A+
 

charette63

XLDnaute Occasionnel
Re : placer un nom à sa place dans une liste (alphabétiquement)

bonjour BrunoM45, sympa de t'interresser à mon problème

le code que tu me proposes pour "l'ajout" d'un nom ne rempli pas mes espérances, peut-etre me suis-je mal exprimé.
Je vais donc essayer de l'expliquer plus schèmatiquement

-dans la userform, je rentre un nom et un prénom: Valider
-le prénom et le nom prennent leur place alphabétiquement dans la liste(accompagnés des autres cellules de leur ligne) en lieu et place de "remplacement 4"
-le tableau doit garder le même nombre de ligne (toutes les données de chaque ligne sont liées à des feuilles excel) soit de la ligne 3 à 10 (dans l'exemple posté)
-les "remplacements" restant ne rentrent pas dans le tri alphabétique et restent en fond de tableau


Ce que le code me donne (ou ne me donne pas)

-les "remplacements" se placent aux quatres premières places de tableau
-le "remplacement 4" n'est pas remplacé par le nouveau nom rentré dans la userform (ce qui à pour conséquence que le tableau augmente d'une ligne
-le nouveau nom rentré dans la user form ne se place pas dans la liste à sa place "alphabétique" (quoique, je remarque que la colonne "B" est rangées alphabétiquement, peut-etre que mon explication "nom-prenom" est inversée dans ma premiere explication, pour ne plus s'emmeler les pinceau: premier critère, colonne A second critere colonne B)


je regarde maintenant ton second code

merci
 

charette63

XLDnaute Occasionnel
Re : placer un nom à sa place dans une liste (alphabétiquement)

re tous le monde,

pour ce qui est du second code, il fonctionne bien quand je rentre des données également dans le textbox2 (textbox amené à disparaitre)
3 remarques
1--ce textbox est appelé à disparaitre puisque c'est la fonction demandée à la macro (trouver le chiffre adéquat à "remplacement")
2--quelque soit la valeur renseignée dans ce textbox ça fonctionne correctement (même une valeur alphabétique???)
3--si je supprime la première partie de la macro (si les deux textbox ne sont pas remplie, msgbox : "il faut remplir tous les champs",
(inutile puisque je ne devrais avoir plus qu'un textbox), j'ai un "variable non définie" au niveau de : Lig = (Me.textBox1.Value)

merci
 

charette63

XLDnaute Occasionnel
Re : placer un nom à sa place dans une liste (alphabétiquement)

merci pour ton intervention Fo_rum, mais comme dit dans mon premier post, je ne sais pas ouvrir les pièces jointes via le serveur de mon boulot. Et j'y suis jusque demain matin.
Si tu repasses faire un tour sur ce fil , ce serais sympa d'y coller le code

merci
 

Fo_rum

XLDnaute Accro
Re : placer un nom à sa place dans une liste (alphabétiquement)

Bonsoir,

USF1
USF1.jpg
Code:
Option Explicit
Private Sub CommandButton1_Click()
    If TextBox1 = "" Or TextBox2 = "" Then
        MsgBox "Vous devez remplir tous les champs !"
        Exit Sub
    End If
    Dim L As Byte, Li As Byte
    L = [A3:A10].Find("remplacement").Row
    Cells(L, 1) = TextBox1
    Cells(L, 2) = TextBox2
    For Li = L + 1 To 10
        Cells(Li, 2) = Li - L
    Next
    Range("A3:G" & L).Sort , key1:=[A3], Order1:=xlAscending, Key2:=[B3], Order2:=xlAscending
    Range("B1").Select
    Unload UserForm1
    UserForm1.Show
End Sub
Private Sub CommandButton2_Click()
    Unload UserForm1
End Sub
USF2 (avec un contrôle LisView)
USF2.jpg
Code:
Option Explicit
Dim L As Byte
Private Sub UserForm_Initialize()
    With ListView1
        For L = 3 To 10
            If Cells(L, 1) <> "remplacement" Then
                .ListItems.Add , ""
                .ListItems(.ListItems.Count).ListSubItems.Add , , Cells(L, 1)
                .ListItems(.ListItems.Count).ListSubItems.Add , , Cells(L, 2)
            End If
        Next
    End With
End Sub
Private Sub CommandButton1_Click()
    Dim Est As Range, L As Byte, Li As Byte
    With ListView1
        For L = 1 To .ListItems.Count
            If .ListItems(L).Checked Then Range(Cells(L + 2, 1), Cells(L + 2, 7)).ClearContents
        Next
        Set Est = [A3:A10].Find("remplacement")
        If Est Is Nothing Then L = 10 Else L = Est.Row - 1
        Range("A3:G" & L).Sort , key1:=[A3], Order1:=xlAscending, Key2:=[B3], Order2:=xlAscending
        Set Est = [A3:A10].Find("")
        If Est Is Nothing Then L = 10 Else L = Est.Row
        For Li = L To 10
            Cells(Li, 1) = "remplacement"
            Cells(Li, 2) = Li - L + 1
        Next
    End With
    Range("B1").Select
    Unload UserForm2
    UserForm2.Show
End Sub

Private Sub CommandButton2_Click()
    Unload UserForm2
End Sub
 

Pièces jointes

  • USF1.jpg
    USF1.jpg
    35.6 KB · Affichages: 97
  • USF1.jpg
    USF1.jpg
    35.6 KB · Affichages: 96
  • USF2.jpg
    USF2.jpg
    26 KB · Affichages: 95
  • USF2.jpg
    USF2.jpg
    26 KB · Affichages: 92

Fo_rum

XLDnaute Accro
Re : placer un nom à sa place dans une liste (alphabétiquement)

Bonsoir,

USF1
USF1.jpg
code
Code:
Option Explicit
Private Sub CommandButton1_Click()
    If TextBox1 = "" Or TextBox2 = "" Then
        MsgBox "Vous devez remplir tous les champs !"
        Exit Sub
    End If
    Dim L As Byte, Li As Byte
    L = [A3:A10].Find("remplacement").Row
    Cells(L, 1) = TextBox1
    Cells(L, 2) = TextBox2
    For Li = L + 1 To 10
        Cells(Li, 2) = Li - L
    Next
    Range("A3:G" & L).Sort , key1:=[A3], Order1:=xlAscending, Key2:=[B3], Order2:=xlAscending
    Range("B1").Select
    Unload UserForm1
    UserForm1.Show
End Sub

Private Sub CommandButton2_Click()
    Unload UserForm1
End Sub
USF2 (avec un contrôle ListView)
USF2.jpg


Code:
ption Explicit
Dim L As Byte
Private Sub UserForm_Initialize()
    With ListView1
        For L = 3 To 10
            If Cells(L, 1) <> "remplacement" Then
                .ListItems.Add , ""
                .ListItems(.ListItems.Count).ListSubItems.Add , , Cells(L, 1)
                .ListItems(.ListItems.Count).ListSubItems.Add , , Cells(L, 2)
            End If
        Next
    End With
End Sub
Private Sub CommandButton1_Click()
    Dim Est As Range, L As Byte, Li As Byte
    With ListView1
        For L = 1 To .ListItems.Count
            If .ListItems(L).Checked Then Range(Cells(L + 2, 1), Cells(L + 2, 7)).ClearContents
        Next
        Set Est = [A3:A10].Find("remplacement")
        If Est Is Nothing Then L = 10 Else L = Est.Row - 1
        Range("A3:G" & L).Sort , key1:=[A3], Order1:=xlAscending, Key2:=[B3], Order2:=xlAscending
        Set Est = [A3:A10].Find("")
        If Est Is Nothing Then L = 10 Else L = Est.Row
        For Li = L To 10
            Cells(Li, 1) = "remplacement"
            Cells(Li, 2) = Li - L + 1
        Next
    End With
    Range("B1").Select
    Unload UserForm2
    UserForm2.Show
End Sub

Private Sub CommandButton2_Click()
    Unload UserForm2
End Sub

pour l'initialisation de la ListView

Personnalisé (ListView1).jpgPersonnalisé (General).jpgpuis voir Index dans Column Headers.
 

Pièces jointes

  • USF1.jpg
    USF1.jpg
    35.6 KB · Affichages: 132
  • USF1.jpg
    USF1.jpg
    35.6 KB · Affichages: 132
  • USF2.jpg
    USF2.jpg
    26 KB · Affichages: 107
  • USF2.jpg
    USF2.jpg
    26 KB · Affichages: 106

charette63

XLDnaute Occasionnel
Re : placer un nom à sa place dans une liste (alphabétiquement)

le premier code me convient parfaitement, merci

je vais maintenant tester le second code, mais avant, je vais tenter de faire ma premiere listview.

Je vous tiens, bien evidement au courant
merci
 

charette63

XLDnaute Occasionnel
Bonjour à toutes et tous,

les codes reçus de Fo_rum fonctionnent correctement sur le petit fichier mis en pièce jointe dans mon premier post.

Sur le fichier de destination, et comme expliqué dans le fichier en pièce jointe, j'ai des liaisons internes et externes entre ce classeur et d'autres. La mise en forme alphabétique proposé dans ces codes "fonctionne" comme la fonction excel "A-->Z" et par conséquent me fais perdre mes liaisons (perdre n'est pas le bon terme, mais les noms et données correspondant à la ligne modifiée et celles d'en dessous ne correspondent plus aux noms des classeurs liés) .
Il aurait fallu, (au risque de me répéter, comme expliqué dans le fichier joint)

A) pour l'ajout d'un employé:
1--copier les prénom et nom (textbox1 et 2) à la place du dernier "remplaçant" de la liste
2--INSERTION d'une ligne au futur emplacement "alphabétique" du nouveau nom
3--COUPER la dernière ligne (celle avec le nouveau nom c à d la dernière ligne du tableau + 1)
4-- COLLER cette ligne dans la nouvelle ligne "insérée"

B) retrait d'un employé (nom)
1--COUPER la ligne de l'employé à supprimer
2--COLLER cette ligne dans la dernière ligne du tableau et la "transformer" en "remplacement" "n°adéquat" (ligne n°11 dans le fichier exemple)
3--SUPPRIMER la ligne "COUPÉE" (donc le tableau a de nouveau 10 lignes)

En définitive, je cherche à automatiser les USF placées dans le fichier joint en premier post pour supprimer la textbox "n° de ligne dans laquelle l'ajout doit être effectué" de la USF1, et la textbox "n° du remplacement à ajouter" de la USF2.

Merci à brunoM45 et à Fo_rum pour l'aide apportée
 

Discussions similaires

Statistiques des forums

Discussions
312 528
Messages
2 089 365
Membres
104 144
dernier inscrit
Mikeml01