XL 2016 Protéger Plage avec condition

Amigo

XLDnaute Occasionnel
Bonjour à tous
J'ai un planning qui s'ouvre à la date du jour.
Je souhaite protéger la zone avec un mot de passe dès le début jusqu'à aujourd'hui -1.
J'ai essayé de bidouiller un code en fouillant sur le site mais pas réussi (voir ci-joint) vu mon niveau moins d'un débutant en VBA. Il protège toute la feuille au lieu de la plage.
Merci par avance pour votre aide
Cordialement

VB:
Dim témoin As Boolean

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim MaxLig As Long, MaxCol As Integer, Lig As Long, Col As Long, C As Integer, coul As Long, champ As Range
Set f1 = Sheets("Année")
    MaxLig = f1.Range("A9").End(xlDown).Row
    MaxCol = f1.Cells(8, Columns.Count).End(xlToLeft).Column
        For Col = 3 To MaxCol
            If f1.Cells(8, Col).Value = Date Then
               Set champ = f1.Cells(9, 3).Resize(MaxLig, Col - 1)
            Exit For
                    If Not Intersect(Target, champ) Is Nothing And Not témoin Then
                       témoin = True
                       ActiveSheet.Unprotect Password:=Monpass
                       Target.Locked = True
                       ActiveSheet.Protect Password:=Monpass
                       témoin = False
                    End If
            End If
        Next Col
End Sub
 

Pièces jointes

  • Planning+fonction_compte_couleur.xlsm
    58 KB · Affichages: 7
Dernière édition:

Amigo

XLDnaute Occasionnel
Désolé, la macro que je venais de poster ne correspondait pas exactement à ce que je voulais te proposer.

Celle-ci semble faire ce que je voulais te proposer (à tester) :
VB:
Private Sub Worksheet_Activate()
'
Dim MaxLig As Long
Dim MaxCol As Integer, MaColonne As Integer

    ActiveSheet.Protect UserInterfaceOnly:=True, DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:=Monpass

    Set f1 = Sheets("Année")
    MaxLig = f1.Range("A9").End(xlDown).Row
    MaxCol = f1.Cells(8, Columns.Count).End(xlToLeft).Column

    On Error GoTo PasTrouve
    MaColonne = Application.Match(CDbl(Date), f1.Range(Cells(8, 3), Cells(8, MaxCol)), 0) + 2

    f1.Range(Cells(9, 3), Cells(MaxLig, MaxCol)).Locked = False
    If MaColonne > 3 Then f1.Range(Cells(9, 3), Cells(MaxLig, MaColonne - 1)).Locked = True
    GoTo Fin

PasTrouve:
    f1.Range(Cells(9, 3), Cells(MaxLig, MaxCol)).Locked = (f1.Range("C8") < Date)

Fin:

End Sub


Théoriquement dans ma proposition il devrait se passer ceci :

- Si la date d'aujourd'hui est trouvée : on déprotège tout le tableau, puis on protège tout ce qui est inférieur à aujourd'hui.

- Si la date d'aujourd'hui n'est pas trouvée : tout le tableau est protégé, ou déprotégé, selon si la première date du tableau (cellule C8) est inférieure, ou non, à la date d'aujourd'hui.
merci pour cette nouvelle version.
je la testerai et vous tiendrai au courant.
Cordialement
 

Discussions similaires

Réponses
13
Affichages
268

Statistiques des forums

Discussions
312 412
Messages
2 088 196
Membres
103 763
dernier inscrit
p.michaux