XL 2019 Besoin d'aide "Protection de page" bloque le fonctionnement Ucase

YAP32

XLDnaute Occasionnel
Bonjour,

J'ai un classeur "Calendrier" tout fonctionne correctement sauf que si je veux protéger par un mot de passe, au cas si on fait une mauvaise manipulation et ma feuille est nommé notamment calendrier mais quand j'aoute

Worksheets("Calendrier").Unprotect "mdp"
Worksheets("Calendrier").Protect "mdp"

les Ucase ne fonctionnent plus.

Je souhaite garder Ucase. Pourriez vous m'aider svp!.

Merci
@+
 

Pièces jointes

  • Calendrier.xlsm
    76.3 KB · Affichages: 10
Solution
Bonjour à tous
Ceci peut être
VB:
Private Sub Worksheet_Change(ByVal Target As Range)

     Dim cl     As Range
     If Not Target Is Nothing Then
          Application.EnableEvents = False
          Application.Calculation = xlCalculationManual
          Application.ScreenUpdating = False
          For Each cl In Target.Cells
               cl.Value = UCase(cl.Value)
          Next
          Application.Calculation = xlCalculationAutomatic
          Application.EnableEvents = True
          Application.ScreenUpdating = True
     End If
    
End Sub

Hasco

XLDnaute Barbatruc
Repose en paix
Bonjour,

D'où l'intérêt de ce que je dis souvent :
N'utilisez On Error Resume Next ou Goto QUE lorsque votre code a été testé et re-testé.
Essayez de commenter la ligne On Error Resume Next, protégez votre feuille et essayez de modifier une valeur. Vous aurez l'avertissement suivant :
1671988000944.png

Qui vous montre que ce n'est pas la ligne avec votre UCase qui rechigne mais la ligne avec SpecialCells.
Dont on peut à mon avis se passer ici.
Si Target est dans la bonne zone alors on fait le test

VB:
Private Sub Worksheet_Change(ByVal Target As Range)

    
     Dim cl As Range
    
      If Not Intersect(Target, Range("A8:NI17")) Is Nothing Then

          Application.EnableEvents = False
          Application.Calculation = xlCalculationManual
          Application.ScreenUpdating = False

          For Each cl In Target.Cells
               cl.Value = UCase(cl.Value)
          Next

          Application.Calculation = xlCalculationAutomatic
          Application.EnableEvents = True
          Application.ScreenUpdating = True
'
'     End If
    
End Sub

La boucle n'est là d'ailleurs que pour gérer les cas où Target auraient plusieurs cellules modifiées en même temps.

Alors continuez votre construction de code sans On Error ou que sur des lignes dont vous maîtrisez réellement la signification et les implications.
Ne vous contentez pas de copier/coller de code dont vous ne comprenez rien.
 

YAP32

XLDnaute Occasionnel
Bonjour Sylvanu,,
Bonjour Hasco,

Merci pour vos aides.

J'ai essayé le fichier de Sylvanu qui me donne erreur ensuite j'ai essayé le code de Hasco situation idem!

Quand je clic sur NextMonth dans le module donne erreur, même chose avec la macro PreviousMonth.

Merci
@+
 

Pièces jointes

  • Err de liaison.PNG
    Err de liaison.PNG
    14 KB · Affichages: 11
  • Err_NextorPrevious.PNG
    Err_NextorPrevious.PNG
    18.7 KB · Affichages: 10
  • Err_NextorPrevious1.PNG
    Err_NextorPrevious1.PNG
    4.5 KB · Affichages: 10

YAP32

XLDnaute Occasionnel
Re,

Il y a plein d'actions impossibles à faire lorsqu'une feuille est protégée !
C'est vous le codeur, à vous de gérer ça.
Déprotéger avant, protéger après.

Pour moi j'ai répondu à la question initiale.
Re,

C'est ce que j'avais fait dans mon message je l'avais mentionné. Déprotéger puis protéger.

Worksheets("Calendrier").Unprotect "mdp"
Worksheets("Calendrier").Protect "mdp"
 

jpb388

XLDnaute Accro
Bonjour à tous
Ceci peut être
VB:
Private Sub Worksheet_Change(ByVal Target As Range)

     Dim cl     As Range
     If Not Target Is Nothing Then
          Application.EnableEvents = False
          Application.Calculation = xlCalculationManual
          Application.ScreenUpdating = False
          For Each cl In Target.Cells
               cl.Value = UCase(cl.Value)
          Next
          Application.Calculation = xlCalculationAutomatic
          Application.EnableEvents = True
          Application.ScreenUpdating = True
     End If
    
End Sub
 

Katido

XLDnaute Occasionnel
Essaye quand même d'ajouter la ligne en gras avant l'intersect :

On Error Resume Next
ActiveSheet.Protect Password:= "LeMotSecret", UserInterfaceOnly:=True
Set c = Intersect(Target, Range("A8:NI17").SpecialCells(xlConstants))
On Error GoTo 0

Chez moi ça marche.

Si nécessaire, pour déprotéger la feuille, il faut le faire avec ActiveSheet.UnProtect Password:= "LeMotSecret"
 

YAP32

XLDnaute Occasionnel
Bonjour à tous
Ceci peut être
VB:
Private Sub Worksheet_Change(ByVal Target As Range)

     Dim cl     As Range
     If Not Target Is Nothing Then
          Application.EnableEvents = False
          Application.Calculation = xlCalculationManual
          Application.ScreenUpdating = False
          For Each cl In Target.Cells
               cl.Value = UCase(cl.Value)
          Next
          Application.Calculation = xlCalculationAutomatic
          Application.EnableEvents = True
          Application.ScreenUpdating = True
     End If
   
End Sub
Merci beaucoup ça fonctionne parfaitement
 

Discussions similaires