Ne mettre que certain mots en majuscule

Bonjour,


Tu copies la fonction dans un module standard :

et dans la cellule tu inscris : =LesMajuscules(A1)
en supposant que ton texte soit en A1

'---------------------------------------------
Function LesMajuscules(Rg As Range)
Dim Arr(), Elt As Variant
Dim X As String, T As Variant

'Tu énumères la liste des lettres qui ne doivent
'pas être en majuscule
Arr = Array("à", "â", "ä", "é", "è", "ê", _
"de", "des", "le", "la", "les", "d'", "l'")

X = Application.Proper(Rg)
For Each Elt In Arr
X = Replace(X, Application.Proper(Elt), Elt)
Next

T = Split(X, " ")
X = ""

'Boucle pour mettre toutes les lettres seules en minuscules.
For Each Elt In T
If Len(Elt) = 1 Then
X = X & LCase(Elt) & " "
Else
X = X & " " & Elt & " "
End If
Next
X = Left(X, Len(X) - 1)

LesMajuscules = X
End Function
'---------------------------------------------



MichD
---------------------------------------------------------------

En complément,

Dans la matrice suivante de la procédure :

'Tu énumères la liste des lettres qui ne doivent
'pas être en majuscule
Arr = Array("à", "â", "ä", "é", "è", "ê", _
"de", "des", "le", "la", "les", "d'", "l'")

Tu devrais lister seulement les mots ou expressions de 2 lettres et plus
comme : Arr = Array("de", "des", "le", "la", "les", "d'", "l'")

La procédure se charge déjà de mettre toutes les lettres "SEULES" en minuscule, accentuées
ou pas.
Nul besoin de faire 2 fois la même chose!

La fonction va sauver l'exécution de quelques boucles à chaque usage.
;-)


MichD
---------------------------------------------------------------

Bonsoir,

La fonction réalise bien le but, mais crée, en contre partie des espace s en superflu entre les mots.

Peux-tu donner quelques exemples ?



MichD
---------------------------------------------------------------

Voir cet exemple,

http://cjoint.com/?BEdvbZHm0zo

Ça devrait rouler comme ça :


'---------------------------------------------
Function LesMajuscules(Rg As Range)
Dim Arr(), Elt As Variant
Dim X As String, T As Variant

'Tu énumères la liste des lettres qui ne doivent
'pas être en majuscule
Arr = Array("de", "des", "le", "la", "les", "d'", "l'", "pcs")

If Rg <> "" Then
X = Application.Proper(Rg)
For Each Elt In Arr
X = Replace(X, Application.Proper(Elt), Elt)
Next

T = Split(X, " ")
X = ""

'Boucle pour mettre toutes les lettres seules en minuscules.
For Each Elt In T
If Len(Elt) = 1 Then
X = X & " " & LCase(Elt)
Else
If Len(Elt) <> 0 Then
X = X & " " & Elt
End If
End If
Next
Else
X = ""
End If
LesMajuscules = X
End Function
'---------------------------------------------



MichD
---------------------------------------------------------------
"Apitos" a écrit dans le message de groupe de discussion :
1513743.1763.1336073090846.JavaMail.geo-discussion-forums@vbay5...

Voir cet exemple,

http://cjoint.com/?BEdvbZHm0zo

Bonjour Denis,

Voila la fonction finale qui marche :


'---------------------------------------------
Function LesMajuscules(Rg As Range)
Dim Arr(), Elt As Variant
Dim X As String, T As Variant

'Tu énumères la liste des lettres qui ne doivent
'pas être en majuscule
Arr = Array("de", "des", "le", "la", "les", "d'", "l'", "pcs", "ml")

X = Application.Proper(Rg)

'Remplacer les mots en majuscule de deux lettres et plus par leur minis cule
'dans le tableau Arr
For Each Elt In Arr
X = Replace(X, Application.Proper(Elt), Elt)
Next

T = Split(X, " ")
X = ""

'Boucle pour mettre toutes les lettres seules en minuscules.
For Each Elt In T
X = IIf(Len(Elt) = 1, X & LCase(Elt) & " ", X & Elt & " ")
Next
LesMajuscules = X
End Function
'---------------------------------------------


Merci bien.

Juste un petit bémol,

à la fin de chaîne de caractères, un as un espace inutile.

Que ce soit à ma fonction ou à la tienne, ce serait avisé de modifier la dernière de code
de cette manière :

LesMajuscules = Trim(X)



MichD
---------------------------------------------------------------

Un petit souci.

Comme j’ai besoin d’appliquer les majuscules pour toute entrée dans l a colonne B, j’ai écrit dans le module de feuille :

'--------------------------------------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, Range([B2], Range("B" & Rows.Count).End(xlUp)) ) Then
LesMajuscules Target
End If
End Sub
'-------------------------------------------------------------------------- -

Mais voila l’exécution de la fonction se répète au moins deux fois avant de
déclencher une erreur d’incompatibilité de type dans la ligne :

If Not Intersect(Target, Range([B2], Range("B" & Rows.Count).End(xlUp))) Then

Et puis je pensais à rendre la fonction en une procédure pour ne pas at tribuer à chaque cellule dans la colonne B la fonction "LesMajuscules"

Comme j’ai remarqué que la fonction traite une chaine gardée en mém oire au lieu de traiter la chaine contenu dans la cellule active (Target) ! !!?

'---------------------------------------------
Function LesMajuscules(Rg As Range)

Dim Arr(), Elt As Variant
Dim X As String, T As Variant

'Tu énumères la liste des lettres qui ne doivent
'pas être en majuscule
Arr = Array("de", "des", "le", "la", "les", "d'", "l'", "pcs", "ml")

X = Application.Proper(Rg)

MsgBox "X1 = " & X

'Remplacer les mots en majuscule de deux lettres et plus par leur minis cule
'dans le tableau Arr
For Each Elt In Arr
X = Replace(X, Application.Proper(Elt), Elt)
Next

T = Split(X, " ")
X = ""

'Boucle pour mettre toutes les lettres seules en minuscules.
For Each Elt In T
X = IIf(Len(Elt) = 1, X & LCase(Elt) & " ", X & Elt & " ")
MsgBox "X2 = " & X
Next
MsgBox "X finale = " & X
LesMajuscules = Trim(X)
End Function 'Sub
'---------------------------------------------

Dans le module de la feuille :
'-----------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rg As Range, C As Range
Set Rg = Intersect(Target, Range([B2], Range("B" & Rows.Count).End(xlUp)))
If Not Rg Is Nothing Then
Application.EnableEvents = False
For Each C In Rg
If C <> "" Then
C.Value = LesMajuscules(C)
End If
Next
Application.EnableEvents = True
End If
End Sub
'-----------------------------------------------

'Dans un module Standard :
'-----------------------------------------------
Function LesMajuscules(Rg As Range)
Dim Arr(), Elt As Variant
Dim X As String, T As Variant

'Tu énumères la liste des lettres qui ne doivent
'pas être en majuscule
Arr = Array("de", "des", "le", "la", "les", "d'", "l'", "pcs")

If Rg <> "" Then
X = Application.Proper(Rg)
For Each Elt In Arr
X = Replace(X, Application.Proper(Elt), Elt)
Next

T = Split(X, " ")
X = ""

'Boucle pour mettre toutes les lettres seules en minuscules.
For Each Elt In T
If Len(Elt) = 1 Then
X = X & " " & LCase(Elt)
Else
If Len(Elt) <> 0 Then
X = X & " " & Elt
End If
End If
Next
Else
X = ""
End If
LesMajuscules = Trim(X)
End Function
'-----------------------------------------------

MichD
---------------------------------------------------------------