Comment saisir une plage de cellule en MAJUSCULE et une autre en minuscule avec une macro sous excel

**Le Samaritain** · 30/05/2015, 20h58

J'ai essayé de cette façon :

Majuscule : (seul ça fonctionne)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
Private Sub Worksheet_Change(ByVal Target As Range)
'Masjuscule automatique
Dim zz
Dim c As Range
Set zz = Intersect(Target, [A4:C1000,G4:J1000,M4:O1000])
If zz Is Nothing Then Exit Sub
Application.EnableEvents = False
 For Each c In zz.Cells
   c = UCase(c)
 Next
Application.EnableEvents = True
End Sub

____________________________________

Minuscule : (seul ça fonctionne)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
Private Sub Worksheet_Change(ByVal Target As Range)
'Masjuscule automatique
Dim zz
Dim c As Range
Set zz = Intersect(Target, [K4:K1000])
If zz Is Nothing Then Exit Sub
Application.EnableEvents = False
 For Each c In zz.Cells
   c = LCase(c)
 Next
Application.EnableEvents = True
End Sub

Mais quand je laisse les deux dans la même feuille, j'ai un message d'erreur " Nom ambigu détecté : Worksheet_Change "

Merci de m'aider les amis !!!!!

**joe.levrai** · 30/05/2015, 22h34

Bonjour,

tu ne peux pas avoir deux procédure pour le même évènement
laquelle VBA choisirait sinon ?

il faut grouper tes deux cas dans une même procédure
tu n'as pas non plus besoin d'instancier un objet range, utilise directement ton Target dont la propriété .Cells te donne sa collection de cellules
et voici au passage une autre méthode pour manipuler ton Intersect : s'il n'y a pas d'Intersect entre les deux, c'est "Nothing" qui est renvoyé

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cell As Range
 
Application.EnableEvents = False
If Not Intersect(Target, [K4:K1000]) Is Nothing Then
    For Each Cell In Target.Cells
        Cell.Value = LCase(Cell.Value)
    Next Cell
ElseIf Not Intersect(Target, [A4:C1000,G4:J1000,M4:O1000]) Is Nothing Then
    For Each Cell In Target.Cells
        Cell.Value = UCase(Cell.Value)
    Next Cell
End If
Application.EnableEvents = True
 
End Sub

**clementmarcotte** · 30/05/2015, 22h41

Bonjour,

La règle en VBA est que l'on ne peut pas avoir deux macros du même nom dans le même module. Même, si ce n'est pas le cas, ici, cela inclut également un nom en minuscules et le même nom en majuscules. C'est pantoute.

Ceci dit, mais sans tester rien n'empêche, si tel est ton désir de mettre les deux ensemble:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Private Sub Worksheet_Change(ByVal Target As Range)
'Masjuscule automatique
   Dim zz, zz1
   Dim c As Range
   Application.EnableEvents = False
   Set zz = Intersect(Target, [A4:C1000,G4:J1000,M4:O1000])
   If zz Is Nothing Then Exit Sub
   Application.EnableEvents = False
   For Each c In zz.Cells
      c = UCase(c)
    Next
   'Minjuscule automatique
    Set zz1 = Intersect(Target, [K4:K1000])
    If zz1 Is Nothing Then Exit Sub
    For Each c In zz.Cells
       c = LCase(c)
   Next
   Application.EnableEvents = True
End Sub

P.S C'est unanimement apprécié que le code soit indenté et balisé. Pour baliser, il faut sélectionner le code et cliquer sur le dièse (#)
P.P.S Désolé Jo pour le télescopage. J'avais pas vu ta réponse assez vite.

**joe.levrai** · 30/05/2015, 23h22

Clement

t'es fatigué ?

que va-t-il se passer si je change la cellule K5 par exemple ?

allez, sors ton mode pas à pas si besoin

(aie, non, pas taper !

ça m'arrive souvent de pas lire les procédures sur ce type de questions )

**Le Samaritain** · 31/05/2015, 11h32

Bonjour Clément,

Merci pour ta réponse

J'ai essayé ta formule par un copier coller, malheureusement ça ne fonctionne pas pour la colonne minuscule.

Ps : Je suis un débutant, tu trouveras ci-joint le fichier pour plus de facilité : Test Le Samaritain.xlsm

**PMO2017** · 31/05/2015, 17h30

Bonjour,

Essayez de remplacer votre code par le code suivant

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ZZ As Range
Dim C As Range
'--- Masjuscule automatique ---
Set ZZ = Intersect(Target, [A4:C1000,G4:J1000,M4:O1000])
If Not ZZ Is Nothing Then
  Application.EnableEvents = False
  For Each C In ZZ.Cells
    C = UCase(C)
  Next C
End If
'--- Minjuscule automatique ---
Set ZZ = Intersect(Target, [K4:K1000])
If Not ZZ Is Nothing Then
  Application.EnableEvents = False
  For Each C In ZZ.Cells
    C = LCase(C)
  Next C
End If
'--- Rétablissement à l'origine ---
Application.EnableEvents = True
End Sub

**Le Samaritain** · 31/05/2015, 18h59

Super !!!!!!!

Un grand merci !!!!!!!!!!!!!!

**joe.levrai** · 31/05/2015, 20h28

Dans la lignée des suggestions qui n'ont servis à rien, une variante avec un seul Intersect pour quand même utiliser ce ZZ qui sert strictement à rien

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Private Sub Worksheet_Change(ByVal Target As Range)
Dim C As Range, ZZ As Range
Dim Maj As Boolean
 
Application.EnableEvents = False
Set ZZ = Intersect(Target, [A4:C1000,K4:K1000,G4:J1000,M4:O1000])
If ZZ Is Nothing Then Exit Sub
If (ZZ.Columns.Count = 1) And (ZZ.Column = 11) Then Maj = True
For Each C In Target.Cells
    If Maj Then
        C.Value = UCase(C.Value)
    Else
        C.Value = LCase(C.Value)
    End If
Next C
Application.EnableEvents = True
 
End Sub

**Le Samaritain** · 31/05/2015, 21h39

Bonsoir Joe,

Je viens d'essayer, je suis navré de devoir te dire que cela ne fonctionne pas.

Bonne soirée

**joe.levrai** · 31/05/2015, 22h03

Il fonctionne très bien (tout comme le premier), il y a juste les évènements qui étaient désactivés un peu trop tôt, j'ai déplacé la ligne au bon endroit
Ca empêchait le code de tourner dès que tu changeais une cellule qui n'était pas dans la plage

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Private Sub Worksheet_Change(ByVal Target As Range)
Dim C As Range, ZZ As Range
Dim Maj As Boolean
 
Set ZZ = Intersect(Target, [A4:C1000,K4:K1000,G4:J1000,M4:O1000])
If ZZ Is Nothing Then Exit Sub
If (ZZ.Columns.Count = 1) And (ZZ.Column = 11) Then Maj = True
Application.EnableEvents = False
For Each C In Target.Cells
    If Maj Then
        C.Value = UCase(C.Value)
    Else
        C.Value = LCase(C.Value)
    End If
Next C
Application.EnableEvents = True
 
End Sub

**Le Samaritain** · 01/06/2015, 20h03

Bonsoir Joe,

Désolé mais ça ne fonctionne pas

**joe.levrai** · 01/06/2015, 21h35

Bonjour,

"ça ne fonctionne pas" ... c'est relativement vague

j'ai testé sur un fichier vierge et je répond "ça fonctionne" en précisant :

- avec une seule cellule modifiée
- avec plusieurs cellules modifiées (copier/coller) avec la colonne K incluse
- avec plusieurs cellules modifiées (copier/coller) sans inclure la colonne K

merci de préciser l'anomalie que tu rencontres

après, c'est toi qui voit, tu as des codes proposés et déjà fonctionnels
j'ai juste voulu te proposer des versions plus concises ... c'est "du bonus" comme on dit

Ps : ton problème ne serait pas que les 2 propositions effectuent le traitement inverse de tes souhaits ? J'ai l'impression d'avoir inversé

si tel est le cas, en prenant mon dernier code, il suffit d'inverser le traitement

voici, et tiens moi au courant

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Private Sub Worksheet_Change(ByVal Target As Range)
Dim C As Range, ZZ As Range
Dim Maj As Boolean
 
Set ZZ = Intersect(Target, [A4:C1000,K4:K1000,G4:J1000,M4:O1000])
If ZZ Is Nothing Then Exit Sub
Maj = True
If (ZZ.Columns.Count = 1) And (ZZ.Column = 11) Then Maj = False
Application.EnableEvents = False
For Each C In Target.Cells
    If Maj Then
        C.Value = UCase(C.Value)
    Else
        C.Value = LCase(C.Value)
    End If
Next C
Application.EnableEvents = True
 
End Sub