Protection de la feuille sauf 2 Cellules

Bonjour, n'étant pas trop à l'aise avec le code VBA, est-il possible d'avoir une macro me permettant de protéger toute la feuille de l'onglet "AGENTS_VN" sauf les cellules A1 et A3 et idem dans l'onglet "RESPONSABLE".

Ceci me permettrait de faire sauter le code VBA que j'ai crée qui empêche l'enregistrement à la fermeture (par crainte d'une bavure)

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Cancel = True 'Annule les demandes d'enregistrement
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Application.ThisWorkbook.Saved = True 'Informe Excel que le fichier a déjà été enregistré (cela évite d'avoir une demande d'enregistrement à la fermeture)
End Sub

Car j'aimerai que lorsque les personnes ferment ce classeur, il y ai un enregistrement car depuis un autre onglet est continuellement alimenté en données.

Merci pour votre aide.

Bonjour,

à tester,

Sub test()
With Sheets("RESPONSABLE")
    .Unprotect ""
    .Cells.Locked = True
    .Range("A1,A3").Locked = False
    .Protect Password:="", DrawingObjects:=True, Contents:=True, Scenarios:=True
End With
End Sub

Peux tu svp m'indiquer ou je colle ton code sachant que sur l'onglet "RESPONSABLE" j'ai déjà un code

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Nom, Periode As String
Dim Hs_Norm, HS_Ferie, HS_Nuit, Total As Single
Dim DrLigne, A As Integer
Dim Test As Boolean

If Not Application.Intersect(Target, Range("A3")) Is Nothing Then
    For i = 32 To 35
        If format(ThisWorkbook.Worksheets("RESPONSABLE").Cells(i, 2), "dd") > 20 Then
            ThisWorkbook.Worksheets("RESPONSABLE").Rows(i + 10).Hidden = True
            ThisWorkbook.Worksheets("RESPONSABLE").Cells(i, 5) = ""
            ThisWorkbook.Worksheets("RESPONSABLE").Cells(i, 6) = ""
            ThisWorkbook.Worksheets("RESPONSABLE").Cells(i, 7) = ""

        Else
            ThisWorkbook.Worksheets("RESPONSABLE").Rows(i + 10).Hidden = False
            ThisWorkbook.Worksheets("RESPONSABLE").Cells(i, 5).FormulaLocal = "=SI(ESTERREUR(TROUVE(""|"";$D" & i & ";1));SIERREUR(RECHERCHEV($D" & i & ";'[Planning Agents VIEUX NICE.xlsm]RESPONSABLE'!$K:$K;1;FAUX);"""");GAUCHE($D" & i & ";TROUVE(""|"";$D" & i & ";1)-2))"
            ThisWorkbook.Worksheets("RESPONSABLE").Cells(i, 6).FormulaLocal = "=SI(ESTERREUR(TROUVE(""|"";$D" & i & ";1));SIERREUR(RECHERCHEV($D" & i & ";'[Planning Agents VIEUX NICE.xlsm]RESPONSABLE'!$K:$K;1;FAUX);$D" & i & ");GAUCHE($D" & i & ";TROUVE(""|"";$D" & i & ";1)-2))"
            ThisWorkbook.Worksheets("RESPONSABLE").Cells(i, 7).FormulaLocal = "=SI(ESTERREUR(TROUVE(""|"";D" & i & ";1));SIERREUR(RECHERCHEV($D" & i & ";'[Planning Agents VIEUX NICE.xlsm]RESPONSABLE'!$K:$N;4;FAUX);"""");STXT(D" & i & ";TROUVE(""|"";D" & i & ";1)+2;999))"
        End If
    Next
    Sheets("RESPONSABLE").Calculate
End If

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Application.Intersect(Target, Range("A1")) Is Nothing Then
    UserFResp.Show
End If
End Sub

Désolé, mais je me permet juste de relancer le sujet.

Encore merci de votre aide.

re,

la macro Test est à exécuter une seul fois, nul besoin de l'inclure dans d'autre macro

Merci mais le soucis, c’est que je ne vois pas où je colle ton code

Merci mais le soucis, c’est que je ne vois pas où je colle ton code

dans un module

ps/ je vois dans ton code que tu as utilisé une variable "test"

tu devrais donner un autre nom à macro que j'ai donnée

Voilà chose faite, ton code dans un nouveau modure

Sub protection()
With Sheets("RESPONSABLE")
    .Unprotect ""
    .Cells.Locked = True
    .Range("A1,A3").Locked = False
    .Protect Password:="", DrawingObjects:=True, Contents:=True, Scenarios:=True
End With
End Sub

Par contre lorsque j'essai d'activer le module, il y a un message d'erreur (cf capture d'écran)

Merci

capture d ecran 2019 04 24 a 17 11 06 capture d ecran 2019 04 24 a 17 11 22

re,

est ce que le mot de passe est ""

Mais il n'y a pas de mot de passe sur ce fichier

Mais il n'y a pas de mot de passe sur ce fichier

le sujet de ce fil n'est pas la "Protection de la feuille sauf 2 Cellules"

J'aimerai sur l'onglet "responsable" protéger toute la feuille sauf la cellule A1 et la cellule A3. Et idem pour l'onglet "AGENTS_VN".

Le fait de protéger toute l'onglet, évitera des erreurs malencontreuses sur des cellules (car il y a énormément de calculs dans la feuille)

Merci

J'aimerai sur l'onglet "responsable" protéger toute la feuille sauf la cellule A1 et la cellule A3. Et idem pour l'onglet "AGENTS_VN".

ok, j'avais compris que l'onglet était déjà protégé.

voici la macro pour mettre la protection,

Sub protection()
Sheets("RESPONSABLE").Activate
Cells.Locked = True
Range("A1").Locked = False
Range("A3").Locked = False
ActiveSheet.Protect Password:="MonPassword", DrawingObjects:=True, Contents:=True, Scenarios:=True

Sheets("AGENTS_VN").Activate
Cells.Locked = True
Range("A1").Locked = False
Range("A3").Locked = False
ActiveSheet.Protect Password:="MonPassword", DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub

J'ai bien collé ce nouveau code dans un module

Sub protection()
Sheets("RESPONSABLE").Activate
Cells.Locked = True
Range("A1").Locked = False
Range("A3").Locked = False
ActiveSheet.PROTECT Password:="MonPassword", DrawingObjects:=True, Contents:=True, Scenarios:=True

Sheets("AGENTS_VN").Activate
Cells.Locked = True
Range("A1").Locked = False
Range("A3").Locked = False
ActiveSheet.PROTECT Password:="MonPassword", DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub

Mais j'ai toujours les même codes d'erreurs (cf capture)

capture d ecran 2019 04 24 a 17 54 48 capture d ecran 2019 04 24 a 17 54 34

Quel sont les adresses des cellules fusionnés ?

à tester,

Sub protection()
Sheets("RESPONSABLE").Activate
Cells.Locked = True
Range("A1:C2").Locked = False
Range("A3:B3").Locked = False
ActiveSheet.Protect Password:="MonPassword", DrawingObjects:=True, Contents:=True, Scenarios:=True

Sheets("AGENTS_VN").Activate
Cells.Locked = True
Range("A1:C2").Locked = False
Range("A3:B3").Locked = False
ActiveSheet.Protect Password:="MonPassword", DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub

ça fonctionne mais le soucis c'est que je n'ai plus accès à la cellule A1 et la macro à l'intérieur, et également à la celluleA3

re,

au lieu d'utiliser la fusion de cellule, tu pourrais utiliser le format "Centré sur plusieurs colonnes"

Je vais essayer, mais je ne suis pas persuadé que la macro dans la cellule A1 fonctionne

Et comment ce fait-il que je n'ai pas Accès à la cellule A3 lors de l’activation de la marco

Même en enlevant la fusion sur les cellules A1 et A3, et en changeant ensuite légèrement le code

Sub protection()
Sheets("RESPONSABLE").Activate
Cells.Locked = True
Range("A1").Locked = False
Range("A3").Locked = False
ActiveSheet.PROTECT Password:="MonPassword", DrawingObjects:=True, Contents:=True, Scenarios:=True

Sheets("AGENTS_VN").Activate
Cells.Locked = True
Range("A1").Locked = False
Range("A3").Locked = False
ActiveSheet.PROTECT Password:="MonPassword", DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub

Je n'ai toujours pas accès à la cellule A1 (dans laquelle il y a soit un menu déroulant-soit une userform), il en est de même pour la cellule A3 auquel je n'ai pas accès pour changer la date.

re,

à tester,

Rechercher des sujets similaires à "protection feuille sauf"