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 '---------------------------------------------
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
'---------------------------------------------
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 '---------------------------------------------
'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. ;-)
'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.
;-)
'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. ;-)
'--------------------------------------------- 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 :
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...
'--------------------------------------------- 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 :
Voir cet exemple,
http://cjoint.com/?BEdvbZHm0zo
Apitos
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.
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
'---------------------------------------------
'--------------------------------------------- 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.
MichD
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 :
Comme jai besoin dappliquer les majuscules pour toute entrée dans l a colonne B, jai é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 lexécution de la fonction se répète au moins deux fois avant de déclencher une erreur dincompatibilité 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 jai 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 '---------------------------------------------
Un petit souci.
Comme jai besoin dappliquer les majuscules pour toute entrée dans l a colonne B, jai é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 lexécution de la fonction se répète au moins deux fois avant de
déclencher une erreur dincompatibilité 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 jai 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
'---------------------------------------------
Comme jai besoin dappliquer les majuscules pour toute entrée dans l a colonne B, jai é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 lexécution de la fonction se répète au moins deux fois avant de déclencher une erreur dincompatibilité 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 jai 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 '---------------------------------------------
MichD
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 '-----------------------------------------------
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
'-----------------------------------------------
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 '-----------------------------------------------