np = Application.Trim(LCase(Chaîne.Value))
np = LCase(Chaîne.Value)
EspacesDoubles = Chr(32) & Chr(32)
temp = Trim(np)
Do Until InStr(temp, EspacesDoubles) = 0
temp = Replace(temp, EspacesDoubles, Chr(32))
Loop
np = temp
Option Explicit
Public Function FirstLetterMaj(Nom_Prénom As Range)
Dim Morceaux() As String, np As String, s As String
Dim i As Integer, tabParticules As Variant
tabParticules = Array("de", "del", "la", "las", "los", "da", "do", "di", "van", "von", "der")
np = Application.Trim(LCase(Nom_Prénom.Value))
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) = "d'" Then
Morceaux(i) = "d'" & UCase(Mid(Morceaux(i), 3, 1)) & Right(Morceaux(i), Len(Morceaux(i)) - 3)
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
Public Function DébutEnMajuscule(Chaîne As Range)
Dim np As String
np = Application.Trim(LCase(Chaîne.Value))
np = UCase(Left(np, 1)) & Right(np, Len(np) - 1)
DébutEnMajuscule = np
End Function
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
Application.EnableEvents = False
On Error GoTo fin
If Not Intersect(Target, Range("Colonne1")) Is Nothing Then
Target = FirstLetterMaj(Target)
End If
If Not Intersect(Target, Range("Colonne2")) Is Nothing Then
Target = DébutEnMajuscule(Target)
End If
If Not Intersect(Target, Range("Colonne3")) Is Nothing Then
Target = UCase(Target)
End If
fin:
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
ActiveSheet.Shapes("maCellule").Delete
On Error GoTo 0
With Target
ActiveSheet.Shapes.AddShape(msoShapeRectangle, .Left, .Top, .Width, .Height).Name = "maCellule"
End With
With ActiveSheet.Shapes("maCellule")
.Fill.Visible = msoFalse
' .Fill.Transparency = 0#
With .Line
.Visible = True: .Weight = 3#: .ForeColor.SchemeColor = 12 'bleu
End With
End With
End Sub
Bonsoir, comment avoir une majuscule seulement sur le premier mot du texte ?Bonsoir,
Solution VBA :
Private Sub Worksheet_Change(ByVal Target As Range)
'Traduit en Nompropre dès la saisie dans la colonne B
If Target.Column = 2 And Target.Count = 1 Then
Target = Application.Proper(Target)
End If
End Sub
;-)
Bonsoir,
Solution VBA :
Private Sub Worksheet_Change(ByVal Target As Range)
'Traduit en Nompropre dès la saisie dans la colonne B
If Target.Column = 2 And Target.Count = 1 Then
Target = Application.Proper(Target)
End If
End Sub
;-)