XL 2016 Protéger Plage avec condition

Amigo · 28 Avril 2024

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

Amigo · 1 Mai 2024

TooFatBoy à dit:
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

Amigo · 3 Mai 2024

Bonjour @TooFatBoy ,@Staple1600 , le forum
Je voudrais vous remercier pour l'aide et le temps que vous m'avez accordé.
@TooFatBoy
La deuxième version a l'air de bien fonctionner. (test sur 2 jours)
Encore merci et longue vie à ce forum d'entraide.
Cordialement

XL 2016 Protéger Plage avec condition

Amigo

XLDnaute Occasionnel

Pièces jointes

Amigo

XLDnaute Occasionnel

Amigo

XLDnaute Occasionnel

Discussions similaires