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

[pat66]

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]

Bonjour Pat,
Avec cette macro tout semble marcher :

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]

bonjour Sylvanu,

un grand merci, cela fonctionne à présent

cdt

Pat

 

[job75]

Bonjour pat66, sylvanu,

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

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]

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

 

[job75]

Il y est.

 

[pat66]

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]

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

 

[pat66]

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]

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

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]

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]

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

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]

Bonjour,

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]

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]

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 ?

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

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