XL 2019 Problème avec Target.Value = UCase(Target.Value)

pat66 · 18 Avril 2021

Bonjour le forum,

pourriez vous me dire pourquoi lorsque je supprime le contenu d'une de ces cellules C6,C7,C9,H6:H7 (exemple erreur de saisie), j'ai un bug sur la ligne : Target.Value = UCase(Target.Value) et la fonction majuscule ne fonctionne plus

Sub Worksheet_Change(ByVal Target As Range)
'Me.Unprotect "jojo"
Application.EnableEvents = False 'désactive les évènements
If Not Application.Intersect(Target, Range("C6,C7,C9,H6:H7")) Is Nothing Then
Target.Value = UCase(Target.Value)
End If
--------------------
----------------------
---------------------
End sub

un grand merci pour votre aide
Cdt
Pat66

sylvanu · 18 Avril 2021

Re,
Je me pose une question : si vous protégez vos feuilles alors un Worksheet_Change ne peut pas marcher puisque la protection interdit de changer une valeur.
En PJ un essai avec un Worksheet_SelectionChange qui dévérouille la feuille quand on clique sur une bonne cellule et un Worksheet_Change pour la modif.

sylvanu · 18 Avril 2021

Bonjour Pat,
Avec cette macro tout semble marcher :

VB:

Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Not Application.Intersect(Target, Range("C6,C7,C9,H6:H7")) Is Nothing Then
    Application.EnableEvents = False    'Désactive les évènements
    Target.Value = UCase(Target.Value)
End If
Application.EnableEvents = True         'Réactive les évènements
End Sub

La ligne If Target.Count > 1 Then Exit Sub évite l'erreur quand plusieurs cellules sont sélectionnées.
Ne pas oublier le Application.EnableEvents = True

pat66 · 18 Avril 2021

bonjour Sylvanu,

un grand merci, cela fonctionne à présent

cdt

Pat

job75 · 18 Avril 2021

Bonjour pat66, sylvanu,

Comme il y a peu de cellules à traiter ceci ira bien :

VB:

Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
Protect "jojo", UserInterfaceOnly:=True
Application.EnableEvents = False 'désactive les évènements
For Each c In [C6:C7,C9,H6:H7]
    c = UCase(c.Formula)
Next
Application.EnableEvents = True 'réactive les évènements
'--------------------
End Sub

Quand la feuille est protégée les modifications manuelles ne sont pas possibles.

A+

sylvanu · 18 Avril 2021

Bonjour Job,
Le second Application.EnableEvents ne devrait il pas être à True ?

job75 · 18 Avril 2021

Il y est.

pat66 · 18 Avril 2021

Bonjour Job75,

j'ai testé votre code, mais ça bloque sur la ligne : c = UCase(c.Formula) et je perds le passage en majuscules "erreur 1004 erreur par l'objet"

job75 · 18 Avril 2021

Si vous retirez UserInterfaceOnly:=True ça bloque forcément.

pat66 · 18 Avril 2021

re,

Pourquoi l'aurais je enlevé,
pour info cela bloque juste après la saisie en minuscule en tapant sur entrée
Dim c As Range
Protect "jojo", UserInterfaceOnly:=True
Application.EnableEvents = False 'désactive les évènements
For Each c In [C6:C7,C9,H6:H7]
c = UCase(c.Formula)
Next
Application.EnableEvents = True

pat66 · 18 Avril 2021

re,
je vous mets la macro complète car peut être que le problème vient d'ailleurs, si vous pouviez y jeter un coup d’œil, ce serait sympa de votre part, merci d'avance

VB:

Sub Worksheet_Change(ByVal Target As Range)
Me.Unprotect "jojo"
Application.EnableEvents = False 'désactive les évènements
If Not Application.Intersect(Target, Range("C6,C7,C9,H6:H7")) Is Nothing Then
    Target.Value = UCase(Target.Value)
  End If
On Error Resume Next
With Sheets(CStr([I3])).UsedRange
    .Columns(3).name = "P" 'plage nommée
    .Columns(4).name = "Q" 'plage nommée
    [I4] = .Cells(Application.Match(1, [(P<>"")*(Q="")], 0), 3)
End With
If Err Then [I4] = "" 'RAZ
Application.EnableEvents = True 'réactive les évènements

Dim nom$, n&
With [C6]
    If Intersect(Target, .Cells) Is Nothing Or .Value = "" Then Exit Sub
    lig = 0 'RAZ de la variable Public
    nom = Trim(.Value)
End With
With Sheets("BDD")
    n = Application.CountIf(.[C:C], nom)
    If n = 0 Then Exit Sub
    If MsgBox("Il y a " & n & " ligne" & IIf(n = 1, "", "s") & " avec le nom '" & nom & "'." _
        & vbLf & "Voulez-vous " & IIf(n = 1, "la", "les") & " consulter ?", 4, "Feuille '" & .name & "'") = 7 Then Exit Sub
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    .Range("A2:DA" & .Range("C" & .Rows.Count).End(xlUp).Row).AutoFilter 3, nom 'filtre automatique
    .Activate
End With
Me.Protect "jojo"
End Sub

job75 · 18 Avril 2021

Je vois que dans votre code Application.EnableEvents = True est placé après modification de la cellule I4.

Donc quand vous collez mon code au-dessus ne collez pas cette instruction.

pat66 · 18 Avril 2021

re,
voila la macro j'y ai inséré votre code, j'ai toujours la même erreur avec un arrêt sur
Target.Value = UCase(Target.Value) et qui désactive la fonction majuscule

Précision importante, tout fonctionnait jusqu'à ce que décide de protéger les feuilles, d'ailleurs votre code sans Protect "jojo", UserInterfaceOnly:=True et a condition que les feuilles soient déprotégées fonctionne aussi très bien,

Cela est un mystère pour moi

VB:

Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
Protect "jojo", UserInterfaceOnly:=True
Application.EnableEvents = False 'désactive les évènements
For Each c In [C6:C7,C9,H6:H7]
c = UCase(c.Formula)
Next
On Error Resume Next
With Sheets(CStr([I3])).UsedRange
    .Columns(3).name = "P" 'plage nommée
    .Columns(4).name = "Q" 'plage nommée
    [I4] = .Cells(Application.Match(1, [(P<>"")*(Q="")], 0), 3)
End With
If Err Then [I4] = "" 'RAZ
Application.EnableEvents = True 'réactive les évènements

Dim nom$, n&
With [C6]
    If Intersect(Target, .Cells) Is Nothing Or .Value = "" Then Exit Sub
    lig = 0 'RAZ de la variable Public
    nom = Trim(.Value)
End With
With Sheets("BDD")
    n = Application.CountIf(.[C:C], nom)
    If n = 0 Then Exit Sub
    If MsgBox("Il y a " & n & " ligne" & IIf(n = 1, "", "s") & " avec le nom '" & nom & "'." _
        & vbLf & "Voulez-vous " & IIf(n = 1, "la", "les") & " consulter ?", 4, "Feuille '" & .name & "'") = 7 Then Exit Sub
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    .Range("A2:DA" & .Range("C" & .Rows.Count).End(xlUp).Row).AutoFilter 3, nom 'filtre automatique
    .Activate
End With
Me.Protect "jojo"
End Sub

TooFatBoy · 18 Avril 2021

Bonjour,

pat66 à dit:
voila la macro j'y ai inséré votre code, j'ai toujours la même erreur avec un arrêt sur
Target.Value = UCase(Target.Value)

Ça ne doit pas être la bonne macro dans ton message car il n'y a pas la ligne d'instruction dont tu parles.

job75 · 18 Avril 2021

Chez moi le code précédent ne crée pas de bug.

Notez que la dernière ligne Me.Protect "jojo" est inutile et doit être supprimée.

Salut Marcel32, oui il n'y a plus de Target.

pat66 · 18 Avril 2021

Bonjour Marcel32,

Pour faire simple
Ma question au post #1 est résolue avec les 2 solutions Sylvanu post #2 et Job post #12, reprises ci dessous

Mon problème commence lorsque je souhaite protéger mes feuilles alors c'est le Krach a tel point que même le classeur ne s'ouvre plus depuis que j'ai utilisé UserInterfaceOnly:=True,

Fort heureusement j'avais fait une copie, donc pour l'instant les solutions de Sylvanu et Job fonctionnent parfaitement tant que mon classeur est déprotégé,et le restera certainement à moins que tu es une autre idée ?

VB:

Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Not Application.Intersect(Target, Range("C6,C7,C9,H6:H7")) Is Nothing Then
Application.EnableEvents = False    'Désactive les évènements
Target.Value = UCase(Target.Value)
End If
Application.EnableEvents = True         'Réactive les évènements
End Sub

VB:

Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
''' Protect "jojo", UserInterfaceOnly:=True  'volontairement désactivé sinon j'ai un krach
Application.EnableEvents = False 'désactive les évènements
For Each c In [C6:C7,C9,H6:H7]
c = UCase(c.Formula)
Next
Application.EnableEvents = True 'réactive les évènements
'--------------------
End Sub

pat

XL 2019 Problème avec Target.Value = UCase(Target.Value)

pat66

XLDnaute Impliqué

sylvanu

sylvanu

XLDnaute Barbatruc

pat66

XLDnaute Impliqué

job75

XLDnaute Barbatruc

sylvanu

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

pat66

XLDnaute Impliqué

job75

XLDnaute Barbatruc

pat66

XLDnaute Impliqué

pat66

XLDnaute Impliqué

job75

XLDnaute Barbatruc

pat66

XLDnaute Impliqué

TooFatBoy

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

pat66

XLDnaute Impliqué

Discussions similaires