Empêcher le changement de nom de feuille ou la suppression

[zephir94]

Bonjour à tous,

Je voudrais par vba empêcher le changement de nom ou la suppression d'une feuille.

J'ai bien pensé à :

ActiveWorkbook.Protect Structure:=True

Sauf que je m’aperçois dans mon code que si j'ai des feuilles masquées et bien sa plante quand je les rends visible ou quand je les masques !
je cherche donc un moyen d'empêcher le changement du nom des feuilles ou la suppression de ces dernières sans bouleverser mes 300 pages de programmation ou il y a des feuilles masquées que je démasques... création d'une nouvelle feuille !

ou je dois repérer dans toute ma prog les événements et repasser à false et true après ?

Merci à vous tous pour vos aides

 

[zephir94]

Re : Empêcher le changement de nom de feuille ou la suppression

Je parts sur la piste suivante dans thisworkbook:

si une feuille devient visible alors je passe à false

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If ThisWorkbook.Sheets.Visible = True Then
ActiveWorkbook.Protect Structure:=False
Else
ActiveWorkbook.Protect Structure:=True
End If
End Sub

mais bon je dois explorer mon code car

ThisWorkbook.Sheets.Visible = True

n'est pas reconnu !

 

[zephir94]

Re : Empêcher le changement de nom de feuille ou la suppression

Bon j'ai trouvé :

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
For She = Sheets.Count To 1 Step -1
If ThisWorkbook.Sheets(She).Visible = True Then
ActiveWorkbook.Protect Structure:=False
Else
ActiveWorkbook.Protect Structure:=True
End If
Next
End Sub

mais par contre malgré :

ActiveWorkbook.Protect Structure:=True

je peux effacer une feuille ou changer son nom !

 

[job75]

Re : Empêcher le changement de nom de feuille ou la suppression

Bonjour zephir94,

A placer dans ThisWorkbook :

Private Sub Workbook_Open()
Dim a(), i&
ReDim a(1 To Me.Sheets.Count, 1 To 2)
For i = 1 To Me.Sheets.Count
  a(i, 1) = Me.Sheets(i).Name
  a(i, 2) = Me.Sheets(i).CodeName
Next
Me.Names.Add "Feuilles", a, Visible:=False 'nom défini masqué
Me.Saved = True 'évite l'invite à la fermeture
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim a, i&, f As Object
a = [Feuilles]
If IsError(a) Then Exit Sub
Application.DisplayAlerts = False
If Me.Sheets.Count <> UBound(a) Then Workbooks.Open Me.FullName
On Error Resume Next
For i = 1 To UBound(a)
  Set f = Nothing: Set f = Me.Sheets(a(i, 1))
  If f Is Nothing Then Workbooks.Open Me.FullName
  If f.CodeName <> a(i, 2) Then Workbooks.Open Me.FullName
Next
End Sub

Edit : sur les 2 instructions :

If f Is Nothing Then Workbooks.Open Me.FullName
If f.CodeName <> a(i, 2) Then Workbooks.Open Me.FullName

la 1ère est en fait inutile.

Car avec On Error Resume Next la seconde exécute Workbooks.Open Me.FullName si f Is Nothing.

A+

 

[zephir94]

Re : Empêcher le changement de nom de feuille ou la suppression

Bonjour Job75 je vais essayer cela, merci pour le coup de main

 

[job75]

Re : Empêcher le changement de nom de feuille ou la suppression

Re,

Bien sûr si l'on veut autoriser l'ajout de feuilles modifier ainsi :

If Me.Sheets.Count < UBound(a) Then Workbooks.Open Me.FullName

A+

 

[ychc]

Re : Empêcher le changement de nom de feuille ou la suppression

et cela ne fonctionerait il pas?

Application.CommandBars("Ply").Enabled = false

 

[mapomme]

Re : Empêcher le changement de nom de feuille ou la suppression

Bonjour à tous,

Un autre essai dans le fichier joint.

dans un module (Module1):

Const FeuillespasTouche = "toto,lolo"

Sub Appliquer_Formule()
Dim xf
  For Each xf In Split(FeuillespasTouche, ",")
    Worksheets(xf).Cells(1, Columns.Count).Formula = "=CELL(""filename"")"
  Next xf
  ThisWorkbook.Unprotect
End Sub

Sub DeprotegerClasseur()
  ThisWorkbook.Unprotect
  DoEvents
End Sub

Dans le module de code de ThisWorkbook:

Private Sub Workbook_Open()
  Appliquer_Formule
End Sub

Et dans chaque module de code des feuilles concernées:

Private Sub Worksheet_Calculate()
On Error GoTo FIN
Application.EnableEvents = False
  Me.Name = "toto"  ' <============== Nom initial de la feuille
FIN:
Application.EnableEvents = True
End Sub

Private Sub Worksheet_Deactivate()
  ThisWorkbook.Protect , True
  SendKeys "{ENTER}", True
  Application.OnTime Now + 1# / 24 / 3600, "DeprotegerClasseur"
End Sub

Private Sub Worksheet_Activate()
  DeprotegerClasseur
End Sub

nota: sur les feuilles pour lesquelles on interdit le changement de nom, on utilise la dernière cellule de la ligne 1 pour y stocker une formule. Si cette cellule n'est pas disponible, on peut changer l'adresse de cette cellule dans la procédure Appliquer_Formule.

 

[odohe]

Bonjour,
Le sujet m'intéresse, par contre je cale un peu pour intégrer le code Workbook open et Worksheet_Activate donné plus haut dans le mien qui est déjà existant, quand j'essai j'ai un message d'erreur qui apparait (comme vous pouvez le constaté je ne suis pas très calé en VBA)

1) Voici mon code Workbook open qui se trouve dans ThisWorkbook

Private Sub Workbook_Open()
  Sheets("Accueil").Select
    Range("A1").Select
With Sheets("Accueil")
        .Protect "toto", UserInterfaceOnly:=True
    End With
End Sub

J'aimerai l'intégrer dans mon code existant

Private Sub Workbook_Open()
  Appliquer_Formule
End Sub

2) Voici mon code Worksheet_Activate() qui se trouve dans la feuille Accueil

Private Sub Worksheet_Activate()
    On Error Resume Next
    Sheets(ActiveCell.Value2).Visible = False
End Sub

J'aimerai aussi l'intégrer dans mon code existant

Private Sub Worksheet_Activate()
  DeprotegerClasseur
End Sub

Merci d'avance.