modif macro NomPropre

  • Initiateur de la discussion Cafrine
  • Date de début
C

Cafrine

Guest
Bonsoir à tous

Après selection de la plage concernée, cette macro doit être executée manuellement...
Serait-il possible de la modifier afin qu'elle s'éxecute automatiquement ?

Sub nompropre()
Dim pos As Integer
Dim nom, prenom As String

For Each cel In Selection
pos = InStr(1, cel, ' ', 1)

nom = Left$(cel, pos)
prenomMaj = Right$(cel, Len(cel) - pos)
prenomMin = Right$(cel, Len(cel) - pos - 1)


cel.Value = UCase(nom) & ' ' & UCase(Left$(prenomMaj, 1)) & prenomMin

Next cel

End Sub

Merci de votre aide
 

galopin01

XLDnaute Occasionnel
Bonsoir,
Ta question n'est pas assez précise : A quel moment veux-tu qu'elle s'exécute automatiquement ?
Quand tu viens de saisir un nom + prénom dans une cellule ?

Cette macro est plutôt prévue pour modifier en bloc toute une colonne
ou on à fait une opération de concaténation mais de toute façon il faudra la modifier. Il faudra donc expliquer un peu plus ce que tu en attend (et dans quelle colonne...)
A+

Message édité par: galopin01, à: 10/04/2005 20:37
 

Philippe

XLDnaute Occasionnel
Salut Cafrine, galopin,

Cafrine, ce code est issu de la réponse à un de test posts précédents où tu demandais que la modification se fasse automatiquement à chaque saisie, je te propose donc de mettre ce code en Worksheet_Change



Private Sub Worksheet_Change(ByVal Target As Range)
Range('A1:J30').Select
For Each vcel In Selection
nom = Trim(vcel.Value)
pos = InStr(1, nom, ' ') - 1
L = Len(nom)
If nom = '' Or pos < 1 Then GoTo suite
prem = UCase(Left(nom, pos))
prenom = LCase(Right(nom, (L - pos)))
modif = prem & ' ' & prenom
Application.EnableEvents = False
vcel.Value = modif
vcel.ShrinkToFit = True
modif = ''
Application.EnableEvents = True
suite:
Next
End Sub
 

dg62

XLDnaute Barbatruc
Bonsoir Cafrine

dans ton post précédent, je t'ai proposé une solution automatique.

Ce que tu demandes ce soir c'est une adaptation de ma premiere proposition.

Une bonne organisation me semble nécessaire. La derniere version proposé ci-dessous des lundi dernier a été finalisée grace à Pascal76 et hervé.

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
' Nom en majuscule et première lettre du prénom en maj le reste en min
Dim pos As Integer
Dim nom, prenom As String
    
If Not Intersect(Range('A3:A20'), Target) Is Nothing Then

    cel = Target.Value
    If cel > '' Then
        pos = InStr(1, cel, ' ', 1)
        nom = Left$(cel, pos)
        prenomMaj = Right$(cel, Len(cel) - pos)
        prenomMin = Right$(cel, Len(cel) - pos - 1)
        cel = UCase(nom) & UCase(Left$(prenomMaj, 1)) & prenomMin
        Application.EnableEvents = False
        Target = cel
        Application.EnableEvents = True
        
    End If
End If
       
End Sub
 

Discussions similaires

Statistiques des forums

Discussions
314 450
Messages
2 109 726
Membres
110 552
dernier inscrit
jasson