Problème avec code MAJUSCULES automatique

[nobru26]

Bonsoir,

J'ai un soucis avec le code de mise en MAJ automatique, il me transforme les nombres en texte je pense car ensuite après la saisie les totaux ne fonctionnent plus et mon format "€" disparait!
Je pense qu'il faut ajouter une condition décimale devant le code mais je sèche...

Private Sub Worksheet_Change(ByVal zz As Range)
On Error Resume Next
If Intersect(zz, [A1:ad2100]) Is Nothing Then Exit Sub
Application.EnableEvents = False
zz = UCase(zz)
Application.EnableEvents = True
End Sub

Merci

PS: Ou alors comment exclure une zone ou délimiter 2 zones ce qui solutionnerais mon soucis!

 

[Victor21]

Re : Problème avec code MAJUSCULES automatique

Bonjour, nobru26.

Probablement un phénomène météorologique local, ou des choses que vous ne nous avez pas dites.
Illustrez votre problème à l'aide d'un fichier qui reproduit le symptome.
Nous pourrons disséquer celui-là, et tenter de débusquer la cause de celui-ci.

 

[nobru26]

Re : Problème avec code MAJUSCULES automatique

Ok pas de soucis,

D'ailleurs par la même ce code me transforme les formules en texte lorsque je suis en developpement (pas trop genant mais c'est une piste).

Voici un exemple.

 

[job75]

Re : Problème avec code MAJUSCULES automatique

Bonjour nobru26, Patrick, le forum,

Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range
Set r = Intersect(Target, [A1:AZ2100])
If r Is Nothing Then Exit Sub
Application.EnableEvents = False
For Each r In r 'en cas d'entrées multiples
  If Not (IsNumeric(r) Or r.HasFormula) Then r = UCase(r)
Next
Application.EnableEvents = True
End Sub

PS : si des petits malins veulent entrer des valeurs d'erreur on utilisera :

If Not (IsNumeric(r) Or IsError(r) Or r.HasFormula) Then r = UCase(r)

Bonne journée.

 

[Dranreb]

Re : Problème avec code MAJUSCULES automatique

Bonjour à tous.

À Not (IsNumeric(r) Or IsError(r)…, j'aurais préféré VarType(r.Value) = vbString.
Mais on peut aussi faire comme ça :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim R As Range, A As Range, C As Range
On Error Resume Next
Set R = Intersect(Target, [A1:AZ2100]).SpecialCells(xlCellTypeConstants, 2)
If Err Then Exit Sub
On Error GoTo 0
Application.EnableEvents = False
For Each A In R.Areas: For Each C In A: C.Value = UCase$(C.Value): Next C, A
Application.EnableEvents = True
End Sub

 

[nobru26]

Re : Problème avec code MAJUSCULES automatique

Bonjour!

Merci pour la modification de code, j'y ai ajouté or isdate(r) car cela me mettait les dates en English.

Cool! @ bientôt