Ptit coup main

Bonjour à tous

Depuis quelques jours j'essai d'effectuer un complément de macro pour classer en ordre alphabétique un enregistrement au click d'un Bouton.

C'est juste un UF servant à créer une liste des personnels et pouvoir les modifier.

j'ai bien tenté quelques essais mais je me retrouve toujours avec un conflit, c'est donc pour cela que je viens vers vous pour de l'aide.

Voici le code du bouton enregistrer/modifier

Option Explicit
Dim Ws As Worksheet
' Nom de l'application
Const strAppName = "Agent"
Dim WsBase As Worksheet

Private Sub CB_Ajouter_Click() 'OK
    Dim no_ligne As Integer 'Declaration des variables en numerique
    Dim iLig As Integer
    Dim oShAgent As Worksheet

'''''''''''''''''''''''''''''''''''''''''''''''
'##Créer code d'alerte en cas d'oubli de remplissage des textbox
'''''''''''''''''''''''''''''''''''''''''''''''
Set oShAgent = Worksheets("Agent")

    If OB_Ajou = True Then
        If TBxAjouNom = "" Or TBxAjouPrenom = "" Then
            MsgBox "Le Nom et Prénom doivent être renseignés.", vbOKOnly + vbInformation, "Information"
         Exit Sub
        End If
    ElseIf OB_Modif = True Then
        If CBxModification.Text = "" Then
            MsgBox "Veuillez sélectionner un nom dans la liste.", vbOKOnly + vbInformation, "Information"
            Me.TBxAjouNom.Value = ""
            Me.TBxAjouPrenom.Value = ""
         Exit Sub
        End If
    End If

'''''''''''''''''''''''''''''''''''''''''''''''
'##Créer code d'alerte au cas ou un Agent exixte déjà
'''''''''''''''''''''''''''''''''''''''''''''''
    'recherche de la ligne
    For iLig = 2 To Sheets("Agent").Range("A65536").End(xlUp).Row
        If oShAgent.Range("A" & iLig).Value = TBxAjouNom & " " & TBxAjouPrenom.Text Then
            'MsgBox "Un agent existe déjà !" & vbCrLf & TBxAjouNom.Text & " " & TBxAjouPrenom.Text, vbExclamation
            MsgBox "La personne" & " " & TBxAjouNom.Text & " " & TBxAjouPrenom.Text & " " & "existe déjà !", vbExclamation
            Exit Sub
        End If
    Next iLig

'''''''''''''''''''''''''''''''''''''''''''''''
'##Créer code d'enregistrement et ou modification sur un même bouton
'''''''''''''''''''''''''''''''''''''''''''''''
    'Si tout est renseigné, un message de confirmation s'affiche
    If MsgBox("Confirmez-vous l'enregistrement de " & vbCrLf & vbCrLf & TBxAjouNom.Text & " " & TBxAjouPrenom.Text & " " & "?", vbYesNo, "Demande de confirmation") = vbNo Then
       Me.TBxAjouNom.Value = ""
       Me.TBxAjouPrenom.Value = ""
       CBxModification.ListIndex = -1
     Exit Sub
    End If

    If OB_Ajou.Value Then  'Ajouter nouveau Nom
        no_ligne = Sheets("Agent").Range("A65536").End(xlUp).Row + 1
    Else
        'Recherche de la ligne pour Modifier nom déjà existant
        no_ligne = -1
        For iLig = 2 To Sheets("Agent").Range("A65536").End(xlUp).Row
            If oShAgent.Range("A" & iLig).Value = CBxModification.Text Then
                no_ligne = iLig
                Exit For
            End If
        Next iLig
        If no_ligne = -1 Then
            MsgBox "Personne non trouvée !" & vbCrLf & CBxModification.Text, vbExclamation
            Exit Sub
        End If
    End If

    oShAgent.Range("A" & no_ligne).Value = TBxAjouNom.Value & " " & TBxAjouPrenom.Value
    oShAgent.Range("B" & no_ligne).Value = TBxAjouNom.Value
    oShAgent.Range("C" & no_ligne).Value = TBxAjouPrenom.Value

    Set oShAgent = Nothing

    Me.TBxAjouNom.Value = ""
    Me.TBxAjouPrenom.Value = ""
    Me.CBxModification.Clear
    AlimCbx1_UF_Agent

End Sub

je joint tout de même le fichier

Cdlt

Bonjour,

Tri des données après ajout du nom

With oShAgent
    .Range("A" & no_ligne).Value = TBxAjouNom.Value & " " & TBxAjouPrenom.Value
    .Range("B" & no_ligne).Value = TBxAjouNom.Value
    .Range("C" & no_ligne).Value = TBxAjouPrenom.Value
    'Tri de A à Z
    .Range("A1:C" & .Range("A" & Rows.Count).End(xlUp).Row).Sort Key1:=.Range("A1"), Order1:=xlAscending, _
    Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
End With

A+

Bonjour Frangy

Merci, ça marche.

J'y avais bien pensé au With mais j'ai tellement essayé de choses que j'avais peur de planter le fichier.

Après quelques essais tout a l'aire bon et fonctionner comme je veux. GRAND MERCI encore.

cdlt

Rechercher des sujets similaires à "ptit coup main"