XL 2013 protéger 2 feuilles de la suppression classeur ouvert

[matte]

bonjour,
comment empêcher la suppression de deux feuilles protéger de mon classeur quand il est ouvert, feuille pomme et feuille orange
svp merci de votre aides

 

[R@chid]

Bonjour,
tu peux protéger le classeur

 

[matte]

bonjour r@chid, le fil,
non en faite ce que je veut c'est garder le classeur ouvert, non protéger .
en premier interdire la suppression du classeur
les feuilles pomme et orange interdire leurs suppressions et leurs modifications .
dans le cas ou je voudrai protéger une ou deux autres feuilles supplémentaire que faudrait t'il faire ? en cas de modification à faire dans les feuilles protéger , le mot de passe renseigner devant le permettre .
merci

 

[matte]

bonjour,
n'ayant eu de réponse je me permet de renouveler ma demande.
merci pour votre aide éventuel

 

[job75]

Bonsoir matte, R@chid,

en premier interdire la suppression du classeur

On peut toujours supprimer un fichier, sauf un fichier système.

Pour les feuilles, comme R@chid l'a dit, protéger le classeur : menu Révision => Protéger le classeur.

A+

 

[matte]

bonjour job75, r@chid,le fil,
je voie merci à vous

 

[Rhysand]

Bonsoir à tous

Je laisse ici un exemple de la façon d'empêcher une feuille d'être supprimée ou renommée

collez le code suivant dans la feuille de calcul, veillez à changer le nom de la feuille de calcul et le nom de code de la feuille de calcul, mon exemple, le nom est "Feuille1" et le code de la feuille de calcul "Feuille1" mais seulement dans ==> Private Sub Worksheet_SelectionChange(ByVal target As Range)

si le projet VBA est protégé, le nom de code de la feuille de calcul sera automatiquement changé par excel, s'il n'est pas protégé, conservez le nom de code de la feuille de calcul, dans les deux cas, le nom de la feuille de calcul est inchangé

Option Explicit

Private Sub Worksheet_BeforeDelete()
'--------------------------------------------------------
'INFORMATION: il n'est pas possible d'empêcher la suppression de la feuille,
'mais une copie complète en est faite, l'original est supprimé,
'la copie est renommée avec le nom de l'original
'--------------------------------------------------------
Dim MyName As String
Dim MyCodName As String
Dim Mywbk As Object, mySheet As Object

'* Capturez l 'original worksheet name
MyName = Application.ThisWorkbook.ActiveSheet.Name
Debug.Print MyName

If IsVBProjectProtected(Application.ThisWorkbook) Then ' (MACRO) pour déterminer si VBProject est protégé ou non
    ' is Protect then cancel is true pour cette tâche
Else
    ' n 'est pas protégé
    Set mySheet = Application.ThisWorkbook.VBProject.VBComponents(Sheets(MyName).CodeName)
    MyCodName = mySheet.Name
    Debug.Print MyCodName
End If

Application.DisplayAlerts = False

'* Renommez le worksheet (Code Nom & feiulle Nom)
Application.ThisWorkbook.ActiveSheet.Name = VBA.Left(MyName, 30) + "old"

If IsVBProjectProtected(Application.ThisWorkbook) Then ' (MACRO) pour déterminer si VBProject est protégé ou non
    ' is Protect then cancel is true pour cette tâche
Else
    ' n 'est pas protégé
    Application.ThisWorkbook.VBProject.VBComponents(Application.ThisWorkbook.ActiveSheet.CodeName).Name = MyCodName + "old"
End If

'* Créez une copie du worksheet
'ThisWorkbook.ActiveSheet.Copy After:=Sheets(ThisWorkbook.ActiveSheet.Index)
Application.ThisWorkbook.ActiveSheet.Copy before:=Sheets(Application.ThisWorkbook.ActiveSheet.Index)

'* Nommez la copie avec le nom d'origine
Application.ThisWorkbook.ActiveSheet.Name = MyName

If IsVBProjectProtected(Application.ThisWorkbook) Then ' (MACRO) pour déterminer si VBProject est protégé ou non
    ' is Protect then cancel is true pour cette tâche
Else
    ' n 'est pas protégé
    Application.ThisWorkbook.VBProject.VBComponents(Application.ThisWorkbook.ActiveSheet.CodeName).Name = MyCodName
End If

MsgBox "Accès refusé: " & vbCrLf & vbCrLf & " • Vous ne pouvez pas supprimer cette feuille! ", vbCritical, " Autorisation en cours!"

Application.DisplayAlerts = True

If Not mySheet Is Nothing Then Set mySheet = Nothing

End Sub

Private Sub Worksheet_SelectionChange(ByVal target As Range) ' refuser le nom de la feuille de changement (uniquement le nom de la feuille - pas de nom de code)

If ThisWorkbook.ActiveSheet.Name <> "Feuille1" Then ' changez le nom de la feuille ici
    On Error Resume Next
    ThisWorkbook.ActiveSheet.Name = "Feuille1" ' changez le nom de la feuille ici
    If Err.Number = 1004 Then GoTo exitSOS:
    MsgBox "Accès refusé: " & vbCrLf & vbCrLf & " • Vous ne pouvez pas changer le nom de la feuille! ", vbCritical, " Autorisation en cours!"
    On Error GoTo 0
End If

exitSOS:
    Exit Sub
End Sub

collez le code suivant dans un module standard

Option Explicit

Public Function IsVBProjectProtected(ByVal myWkb As Workbook) As Boolean ' déterminer si vbproject est protégé

Dim i As Integer
i = -1

On Error Resume Next
i = myWkb.VBProject.VBComponents.Count
On Error GoTo 0

If i = -1 Then
    IsVBProjectProtected = True
Else
    IsVBProjectProtected = False
End If

End Function

 

[matte]

bonjour Rhysand,li fil,
merci pour votre intervention je vais voir si votre proposition va pouvoir régler mon soucis actuel, je c'est bien qu'il n'y à de problème sans solution, mes mes capacité vba ne sont pas suffisante pour le faire seul ,j'apprécie d'autant plus votre aide