Protection feuille selon période

Bonjour à tous,

je bloque sur un sujet qui a déjà été traité mais d'une autre façon.

J'ai dans mon fichier Excel une feuille par mois (Janvier -> Décembre).

J'aimerais que les feuilles des mois précédents du mois actuel se vérouillent automatiquement, mais avec une subtilité: jusqu'au 4ème jour ouvré du mois, la feuille du mois m-1 reste débloqué, ensuite c'est clôturé.

Ex:

a)nous sommes le 3 Décembre 2015, les feuilles de Janvier à Octobre inclus sont vérouillées par mdp, les mois de Novembre et Décembre sont dévérouillés.

b)nous sommes le 10 Décembre 2015, les feuilles de Janvier à Novembre inclus sont vérouillées par mdp, le mois de Décembre est dévérouillé.

J'avais commencé par le code suivant:

Private Sub Workbook_Open()

m = Month(Date)

For n = 1 To 12

If n <> m And n <> m + 1 Then Sheets(n).Protect "mdp" Else Sheets(n).Unprotect "mdp"

If Day(Now) > 6 And n = m - 1 Then Sheets(n).Protect "mdp" Else Sheets(n).Unprotect "mdp"

Next

End Sub

Mais ça ne fonctionne pas car je ne réussis pas à imbriquer ces 2 conditions (et la fonction ne prend pas en compte les jours ouvrés).

Pouvez-vous m'aider s'il vous plait?

Merci beaucoup,

Romain.

Bonsoir,

Ci-joint une proposition à tester.

Ne prend pas en compte les jours fériés

Bonne soirée

Bouben

Bonjour,

Une proposition à étudier.

Cdlt.

10romain35.xlsm (25.88 Ko)
Option Explicit
'--------------------------------------------------------------------------
Private Sub Workbook_Open()
Dim iMonth As Integer
Dim dtStart As Date
Dim dtEnd As Date
Dim I As Byte

    Application.ScreenUpdating = False

    iMonth = Month(Date)
    dtStart = DateSerial(Year(Date), iMonth, 1)
    dtEnd = Application.WorksheetFunction.WorkDay(dtStart, 4)

    Select Case iMonth
        Case 1
            '
        Case Else
            For I = 1 To iMonth - 2
                Me.Worksheets(I).protect "mdp"
            Next
            If Date > dtEnd Then Me.Worksheets(iMonth - 1).protect "mdp"
    End Select

End Sub
'--------------------------------------------------------------------------
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim ws As Worksheet

    Application.ScreenUpdating = False

    For Each ws In ThisWorkbook.Worksheets
        ws.unprotect "mdp"
    Next ws

    ThisWorkbook.Save

End Sub

Merci Bouben et Jean-Eric! vos deux propositions de codes fonctionnent parfaitement et me sont très utiles

Très bonnes fêtes à vous,

Romain.

Rechercher des sujets similaires à "protection feuille periode"