Microsoft 365 Protection d'une feuille en VBA

[Jacko17]

Bonsoir tout le monde,

J'ai voulus verrouiller une feuille avec des segments de filtration. mais, je me suis rendu compte que je ne pouvais pas les utiliser avec une feuille verrouillée.

je peux la protéger en manuel, en cliquant sur "modifier les objets" et "utiliser le filtre automatique".


Mais, je parviens pas à l'écrire en VBA, Les essais effectuées ne fonctionne pas, code ci-dessous.

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

Private Sub CommandButton1_Click()

    Dim dl As Integer

        With Sheets("BDMasques")

            .Unprotect Password:=*****

                If Me.Cbx_Nom <> "" And Me.Cbx_Types <> "" And Me.Txt_date <> "" And Me.Txt_quantité <> "" Then
                    Sheets("BDMasques").ListObjects(1).ListRows.Add
                        dl = Sheets("BDMasques").Range("b9999").End(xlUp).Row

                        Sheets("BDMasques").Range("B" & dl) = Me.Cbx_Nom
                        Sheets("BDMasques").Range("C" & dl) = Me.Cbx_Types
                        Sheets("BDMasques").Range("D" & dl) = CInt(Me.Txt_quantité)
                        Sheets("BDMasques").Range("E" & dl) = Me.Txt_date

                        ThisWorkbook.Save

                        Unload Ajouts_Masques

                End If

            .Protect Password:=*****, _
            AllowSorting:=True, _
            AllowFiltering:=True

        End With

End Sub

 

[Phil69970]

Bonjour @Jacko17

Le principe général pour ce que tu as demandé:

ActiveSheet.Unprotect Password:="123"
'Le reste de ton code
'Blablabla....
ActiveSheet.Protect Password:="123", DrawingObjects:=False, Contents:=True, Scenarios:=True, AllowFiltering:=True

Ce qui donne :

Private Sub CommandButton1_Click()
Dim dl As Integer

With Sheets("BDMasques")
    .Unprotect Password:="123"
  
    If Me.Cbx_Nom <> "" And Me.Cbx_Types <> "" And Me.Txt_date <> "" And Me.Txt_quantité <> "" Then
        Sheets("BDMasques").ListObjects(1).ListRows.Add
        dl = Sheets("BDMasques").Range("b9999").End(xlUp).Row
      
        Sheets("BDMasques").Range("B" & dl) = Me.Cbx_Nom
        Sheets("BDMasques").Range("C" & dl) = Me.Cbx_Types
        Sheets("BDMasques").Range("D" & dl) = CInt(Me.Txt_quantité)
        Sheets("BDMasques").Range("E" & dl) = Me.Txt_date
      
        ThisWorkbook.Save
        Unload Ajouts_Masques
    End If
  
    .Protect Password:="123", DrawingObjects:=False, Contents:=True, Scenarios:=True, AllowFiltering:=True
End With

End Sub

*Évidement tu mets ce que tu veux en MdP

Bonne fêtes

*Merci de ton retour

@Phil69970

 

[Jacko17]

Bonjour Phil69970,

Merci beaucoup pour ton aide.
Je viens de tester et ça fonctionne !!

Passe de bonne fêtes