Problème d'exécution 1004 - NumberFormat de la classe Range

Bonjour à tous,

un de mes fichiers que j'ai toujours utilisé me pose un souci depuis un mois. On doit organiser une kermesse l'année prochaine. J'ai créé un automatisme. Dans la première feuille, cellule A4, lorsque je met une date, excel la reporte sur les feuilles suivantes avec le rythme de +6 jours et modifie aussi le nom sur les onglets relatifs.

Par contre, lorsque je veux protéger la feuille il me met l'erreur d'exécution alors qu'avant cela fonctionnait.... quelqu'un à une idée de ce que je fait faux ?

Je suis conscient que j'ai un peu "bricolé" avec des macros

Bonjour vinzu01,

Si les feuilles sont protégées, il est nécessaire d'ôter la protection avant d'écrire dans les différentes feuilles.

Dans "Module2" remplacer le contenu par

Public Const WS_PASWD = "VotreMotDePasse"    ' VotreMotDePasse est à remplacer par la valeur du mot de passe utilisé.

Sub unprotect_all_sheets()
    On Error GoTo booboo
    unpass = InputBox("Please enter the password:")
    if unpass <> WS_PSWD then
        MsgBox "There is s problem - check your password, capslock, etc."
        on error goto 0
        exit sub
    End If
    For Each Worksheet In ActiveWorkbook.Worksheets
        Worksheet.Unprotect Password:=unpass
    Next
    Exit Sub
booboo: MsgBox "There is s problem - check your password, capslock, etc."
End Sub

Le code de la procédure "Worksheet_Cange" de la 1ère feuille est à modifier comme suit :

Private Sub Worksheet_Change(ByVal Target As Range)
     With Target
          If .Address <> "$A$4" Then Exit Sub     'c'était pas A4 qui etait modifié
          If Me.Name <> ThisWorkbook.Worksheets(1).Name Then Exit Sub     'cette feuille n'a pas l'index 1 (n'est pas la 1ière)
          If Not IsDate(.Value) Then Exit Sub     'ce n'est pas une date
          If WorksheetFunction.Median(DateSerial(2020, 1, 1), DateSerial(2049, 12, 31), .Value) <> .Value Then Exit Sub     'ce n'est pas une date des années 2020-'29

               For i = 1 To ThisWorkbook.Worksheets.Count     'boucle toutes les feuilles
                  With ThisWorkbook.Worksheets(i)
                     .Unprotect WS_PSWD
                     If i > 1 Then .Range("A4") = Target.Value + (i - 1) * 6     'A4 = A4 de la première feuille + multiple de 6
                     .Range("A4").NumberFormat = "dddd dd mmmm yyy"
                     s = Format(.Range("A4").Value, "dd.mm.yy")     'en format texte "jjjj jj mmmm aaa"
                     On Error Resume Next
                     ThisWorkbook.Worksheets(s).Name = "X_" & Rnd     ' s'il existe déjà une feuille avec ce nom, renommez-la !
                     On Error GoTo 0
                     .Name = s     'renommez cette feuille
                     .Protect WSPSWD
               End With
          Next
     End With
End Sub

Pour que le code VB ne soit pas visible, je vous conseille de protéger le projet VB. Dans la fenêtre du projet (CTRL+R si pas visible), clic droit sur le nom du projet, "Propriété du projet" / "Protection", cocher "Verouiller le projet pour l'affichage", indiquer et confirmer un mot de passe (il peut être identique à celui indiqué dans la constante WS_PSWD mais ne l'oublier pas ...) puis OK.

Le code présent dans les modules des autres feuilles peut être supprimé puisqu'une des conditions est d'être sur la 1ère feuille.

Cdlt,

Cylfo

Bonjour,

C'est parfait, un tout grand merci. J'ai juste corrigé une mini erreur, car il manquait le A : .Unprotect WS_PASWD

Par contre, toute dernière chose, il me reprotège la feuille ensuite, mais en enlevant le mot de passe...

Private Sub Worksheet_Change(ByVal Target As Range)
     With Target
          If .Address <> "$A$4" Then Exit Sub     'c'était pas A4 qui etait modifié
          If Me.Name <> ThisWorkbook.Worksheets(1).Name Then Exit Sub     'cette feuille n'a pas l'index 1 (n'est pas la 1ière)
          If Not IsDate(.Value) Then Exit Sub     'ce n'est pas une date
          If WorksheetFunction.Median(DateSerial(2020, 1, 1), DateSerial(2049, 12, 31), .Value) <> .Value Then Exit Sub     'ce n'est pas une date des années 2020-'29

               For i = 1 To ThisWorkbook.Worksheets.Count     'boucle toutes les feuilles
                  With ThisWorkbook.Worksheets(i)
                     .Unprotect WS_PASWD
                     If i > 1 Then .Range("A4") = Target.Value + (i - 1) * 6     'A4 = A4 de la première feuille + multiple de 6
                     .Range("A4").NumberFormat = "dddd dd mmmm yyy"
                     s = Format(.Range("A4").Value, "dd.mm.yy")     'en format texte "jjjj jj mmmm aaa"
                     On Error Resume Next
                     ThisWorkbook.Worksheets(s).Name = "X_" & Rnd     ' s'il existe déjà une feuille avec ce nom, renommez-la !
                     On Error GoTo 0
                     .Name = s     'renommez cette feuille
                     .Protect WSPSWD
               End With
          Next
     End With
End Sub

Re,

Désolé pour les erreurs, il faut aussi corriger la ligne .Protect WSPSWD (il y a une double erreur ) en .Protect WS_PASWD .

Cdlt,

Cylfo