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

[YAP32]

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
@+

 

[sylvanu]

Bonsoir Yap,
Après essai, cela semble marcher. Voir PJ.

 

[Hasco]

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 :

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

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]

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
@+

 

[Hasco]

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.

 

[YAP32]

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"

 

[Katido]

Bonjour,

Si le code est bien maitrisé, on peut protéger avec le paramètre UserInterfaceOnly:=True qui permet les modifs par VBA. Je ne conseille pas trop mais ça peut dépanner.

 

[YAP32]

Bonjour,

Si le code est bien maitrisé, on peut protéger avec le paramètre UserInterfaceOnly:=True qui permet les modifs par VBA. Je ne conseille pas trop mais ça peut dépanner.

Bonjour,

Pourquoi vous ne le conseiller pas ?

 

[Katido]

Je ne pourrais pas retrouver l'exemple, mais j'ai le souvenir que ça ne marche pas à 100%.

 

[YAP32]

Bonjour,

Je n'ai toujours pas de solution est-ce que quelqu'un pourra m'aider svp!

Merci
@+

 

[jpb388]

Bonjour à tous
Ceci peut être

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]

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]

Bonjour à tous
Ceci peut être

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

 

[Hasco]

Bonjour,

Je n'ai toujours pas de solution est-ce que quelqu'un pourra m'aider svp!

La seule différence entre la macro du post#3 et celle du post#11 est le fait que celle du post#11 s' applique à toutes les cellules de la feuille !!!
Celle du post#3 répondait à la demande telle posée en #1.

J'ai encore perdu du temps pour rien

 

[jpb388]

Bonjour
excuse moi Hasco je n'avais pas fait attention que tu avais déjà répondu en poste 3
Bonne fête