Une sympathique fonction pour taper Prénom + Nom

Magic_Doctor · 22 Novembre 2007

J'avais concocté cette fonction (m'inspirant d'autres...). Autant que ceux intéressés en profitent...
Tapez tout en minuscule. S'il y a des espaces excédentaires, pas de broblème. Plus de problèmes non plus avec les noms avec particules (de Machin) et autres McZinzin... Tout se corrige automatiquement ! Vraiment pratique si vous devez taper quantité d'identités.

Code :

Public Function FirstLetterMaj(Nom_Prénom As Range)

Dim Morceaux() As String, temp As String, EspacesDoubles As String
Dim i As Integer, np As String, s As String

np = LCase(Nom_Prénom.Value)

EspacesDoubles = Chr(32) & Chr(32)
temp = Trim(np)
Do Until InStr(temp, EspacesDoubles) = 0
temp = Replace(temp, EspacesDoubles, Chr(32))
Loop

np = temp

Morceaux = Split(np, " ")
For i = LBound(Morceaux) To UBound(Morceaux)
If Morceaux(i) = "de" Or Morceaux(i) = "del" Or Morceaux(i) = "la" Or Morceaux(i) = "las" Or Morceaux(i) = "los" Or Morceaux(i) = "da" Or Morceaux(i) = "do" Or Morceaux(i) = "di" Or Morceaux(i) = "van" Or Morceaux(i) = "von" Or Morceaux(i) = "der" Then
s = s & (Morceaux(i)) & " "
ElseIf Left(Morceaux(i), 2) = "mc" Then
Morceaux(i) = "Mc" & UCase(Mid(Morceaux(i), 3, 1)) & Right(Morceaux(i), Len(Morceaux(i)) - 3)
s = s & (Morceaux(i)) & " "
Else
s = s & WorksheetFunction.Proper(Morceaux(i)) & " "
End If
Next
FirstLetterMaj = Trim(s)
End Function

Compte Supprimé 979 · 22 Novembre 2007

Re : Une sympathique fonction pour taper Prénom + Nom

Salut MAGIC_DOCTOR,

Merci pour ton petit code, moi je connaissais la fonction : =NOMPROPRE()

Mais, il est vrai que pour les espaces en trop ça ne traitait rien

Pourquoi pas ...

fred65200 · 22 Novembre 2007

Re : Une sympathique fonction pour taper Prénom + Nom

bonsoir
une petite modification peut être,.

plutôt que d'avoir une condition interminable, pourquoi ne pas mettre les particules dans un tableau et de vérifier si ce "morceau" fait parti de tableau

Code:

Dim tabParticules As Variant
tabParticules = Array("de", "del", "la", "las", "los", "da", "do", "di", "van", "von", "der")
Morceaux = Split(np, " ")
For i = LBound(Morceaux) To UBound(Morceaux)

If Not IsError(Application.Match(Morceaux(i), tabParticules, 0)) Then

'If Morceaux(i) = "de" Or Morceaux(i) = "del" Or Morceaux(i) = "la" Or _ Morceaux(i) = "las" Or 'Morceaux(i) = "los" Or Morceaux(i) = "da" Or _ Morceaux(i) = "do" Or Morceaux(i) = "di" Or 'Morceaux(i) = "van" Or _ Morceaux(i) = "von" Or Morceaux(i) = "der" Then

s = s & (Morceaux(i)) & " "

cordialement

Magic_Doctor · 22 Novembre 2007

Re : Une sympathique fonction pour taper Prénom + Nom

Merci Fred pour ton conseil.
Le problème, c'est que je suis un bidouilleur en VBA...
En effet, c'est nettement plus élégant et clair, surtout si l'on veut aisément rajouter des exceptions orthographiques qui doivent rester en minuscule.
Si j'écris : MARIE-EMANUELLE DE LA MCINTOCHE, j'aurais : Marie-Emanuelle de la McIntoche
Espaces superflus seront supprimés et les majuscules respectées.

Voici donc la fonction revue et corrigée par tes soins :

Public Function FirstLetterMaj(Nom_Prénom As Range)

Dim Morceaux() As String, temp As String, EspacesDoubles As String
Dim i As Integer, np As String, s As String
Dim tabParticules As Variant

tabParticules = Array("de", "del", "la", "las", "los", "da", "do", "di", "van", "von", "der")

np = LCase(Nom_Prénom.Value)

EspacesDoubles = Chr(32) & Chr(32)
temp = Trim(np)
Do Until InStr(temp, EspacesDoubles) = 0
temp = Replace(temp, EspacesDoubles, Chr(32))
Loop

np = temp

Morceaux = Split(np, " ")
For i = LBound(Morceaux) To UBound(Morceaux)
If Not IsError(Application.Match(Morceaux(i), tabParticules, 0)) Then
s = s & (Morceaux(i)) & " "
ElseIf Left(Morceaux(i), 2) = "mc" Then
Morceaux(i) = "Mc" & UCase(Mid(Morceaux(i), 3, 1)) & Right(Morceaux(i), Len(Morceaux(i)) - 3)
s = s & (Morceaux(i)) & " "
Else
s = s & WorksheetFunction.Proper(Morceaux(i)) & " "
End If
Next
FirstLetterMaj = Trim(s)
End Function

Une sympathique fonction pour taper Prénom + Nom

Magic_Doctor

XLDnaute Barbatruc

Compte Supprimé 979

Guest

fred65200

XLDnaute Impliqué

Magic_Doctor

XLDnaute Barbatruc

Discussions similaires