vbProperCase

[jim]

Bonjour à tous,

J'ai une macro qui nettoie les noms dans un fichier, en retirant les accents, en mettant une majuscule à l'initiale, etc...
Seul problème avec les noms qui comportent un tiret (genre "Blanc-Sec"), ma macro ne met pas de majuscule au second mot... (exple : Blanc-sec)

Voici la partie de macro concernée :

testNom = StrConv(nom, vbProperCase)

'test tiret espace

posTiret = InStr(1, LTrim(testNom), "-")
posEspace = InStr(1, LTrim(testNom), " ")

If (posTiret <> 0) Then
lettreN = Left(testNom, posTiret - 1) + Mid(testNom, posTiret + 1)
ElseIf (posEspace <> 0) Then
lettreN = Left(testNom, posEspace - 1) + Mid(testNom, posEspace + 1)
Else
lettreN = Trim(testNom)
End If
testNom = lettreN

Si vous avez une astuce, elle sera bien évidemment la bienvenue.
Jim

 

[Creepy]

Salut le forum, Jim

Houlala tu t'embetes bien !

Regarde ce que j'ai fait moi. Cela marche impecc, avec ou sans tiret.
----
Private Sub Dede()
Dim Majus1 As Variant
On Error Resume Next
For Each Majus1 In Selection
Majus1.Value = Application.WorksheetFunction.Proper(Majus1.Value)
Next
End Sub
-----

+++

Creepy

 

[jim]

Salut, merci de cette prompte réponse, par contre, comment je l'intègre dans le reste de la macro ? la voici entière :



Sub Infos_ProperCase_Maxi()

Dim nom As String
Dim prenom As String
Dim w As Long
Dim carac As String
Dim compare As Variant

Dim j As Integer
debut = InputBox("Première ligne ?", "Debut")
fin = InputBox("Dernière ligne ?", "Fin")
If debut = "" Then Exit Sub
If fin = "" Then Exit Sub
k = CInt(debut)
l = CInt(fin)

For j = k To l
nom = Trim(Cells(j, 1))
prenom = Trim(Cells(j, 2))
testNom = StrConv(nom, vbProperCase)
testPrenom = StrConv(prenom, vbProperCase)

'test tiret espace

posTiret = InStr(1, LTrim(testNom), "-")
posEspace = InStr(1, LTrim(testNom), " ")

If (posTiret <> 0) Then
lettreN = Left(testNom, posTiret - 1) + Mid(testNom, posTiret + 1)
ElseIf (posEspace <> 0) Then
lettreN = Left(testNom, posEspace - 1) + Mid(testNom, posEspace + 1)
Else
lettreN = Trim(testNom)
End If
testNom = lettreN



posTiret = InStr(1, LTrim(testPrenom), "-")
posEspace = InStr(1, LTrim(testPrenom), " ")

If (posTiret <> 0) Then
lettreP = Left(testPrenom, posTiret - 1) + Mid(testPrenom, posTiret + 1)
ElseIf (posEspace <> 0) Then
lettreP = Left(testPrenom, posEspace - 1) + Mid(testPrenom, posEspace + 1)
Else
lettreP = Trim(testPrenom)
End If
testPrenom = lettreP


'test sur caractères spéciaux
For w = 225 To 252 Step 1
carac = Chr(w)
compare = InStr(1, testPrenom, carac, 1)
If compare <> 0 Then
Select Case w
Case 224 To 229
Mid(testPrenom, compare, 1) = "a"
w = w - 1
Case 231
Mid(testPrenom, compare, 1) = "c"
w = w - 1
Case 232 To 235
Mid(testPrenom, compare, 1) = "e"
w = w - 1
Case 236 To 239
Mid(testPrenom, compare, 1) = "i"
w = w - 1
Case 241
Mid(testPrenom, compare, 1) = "n"
w = w - 1
Case 242 To 246
Mid(testPrenom, compare, 1) = "o"
w = w - 1
Case 249 To 252
Mid(testPrenom, compare, 1) = "u"
w = w - 1
End Select
End If

'écriture du prénom corrigé dans la feuille
Cells(j, 2) = testPrenom

Next w
For w = 225 To 252 Step 1
carac = Chr(w)
compare = InStr(1, testNom, carac, 1)
If compare <> 0 Then
Select Case w
Case 224 To 229
Mid(testNom, compare, 1) = "a"
w = w - 1
Case 231
Mid(testNom, compare, 1) = "c"
w = w - 1
Case 232 To 235
Mid(testNom, compare, 1) = "e"
w = w - 1
Case 236 To 239
Mid(testNom, compare, 1) = "i"
w = w - 1
Case 241
Mid(testNom, compare, 1) = "n"
w = w - 1
Case 242 To 246
Mid(testNom, compare, 1) = "o"
w = w - 1
Case 249 To 252
Mid(testNom, compare, 1) = "u"
w = w - 1
End Select
End If

'écriture du nom corrigé dans la feuille
Cells(j, 1) = testNom

Next w
Next j
End Sub