@Propercase en LS
Publié: 22 Juil 2005 à 17:39- Code : Tout sélectionner
Public Function ProperCase_LS(Byval Source As String, Byval nbFirstWord As Integer) As String
' Source chaine de texte a traiter
' nbFirstWord : true ne traite que le premier mot, false traite tous les mots
Dim Char As String
Dim i As Long
Dim nbMajuscule As Integer
On Error Goto ErreurHandle
If Trim(Source) = "" Then
ProperCase_LS = Source
End If
ProperCase_LS = ""
Char = ""
Select Case nbFirstWord
Case True
nbMajuscule = False
For i = 1 To Len(Source)
Char = Mid(Source,i,1)
If nbMajuscule = False Then
If Char Like "*[a-z,A-Z]*" Then 'Champ pouvant être mis en majuscule
ProperCase_LS = ProperCase_LS+Ucase(Char)
nbMajuscule = True
Else
ProperCase_LS = ProperCase_LS+lcase(Char)
End If
Else
ProperCase_LS = ProperCase_LS+lcase(Char)
End If
Char = ""
Next
i=0
Case False
nbMajuscule = True
For i = 1 To Len(Source)
Char = Mid(Source,i,1)
Select Case Char
Case " ","-" 'liste des champ derriere lesquel on peut mettre en majuscule
ProperCase_LS = ProperCase_LS+Char
nbMajuscule = True
Case Else
If nbMajuscule = True Then
If Char Like "*[a-z,A-Z]*" Then 'Champ pouvant être mis en majuscule
ProperCase_LS = ProperCase_LS+Ucase(Char)
nbMajuscule = False
Else
ProperCase_LS = ProperCase_LS+lcase(Char)
End If
Else
ProperCase_LS = ProperCase_LS+lcase(Char)
End If
End Select
Char = ""
Next
i=0
Case Else
ProperCase_LS = Source
Exit Function
End Select
Exit Function
ErreurHandle:
Msgbox "("+Cstr(Getthreadinfo (1))+" Call by "+Cstr(Getthreadinfo(10))+")"+Chr(10)+"Erreur " + Str(Err) + " : "+Chr(10) + Cstr(Error)+". "+Chr(10)+"Ligne N° "+Cstr(Erl),16," ERREUR !" ProperCase_LS = ""
Exit Function
End Function
