Ptit coup main
p
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 Subje joint tout de même le fichier
Cdlt
f
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 WithA+
p
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