Discussion :

[mobiclick]

Bonjour le forum,

Est-il possible d'interdire l'insertion d'une nouvelle feuille sous excel 2007 ; j'entends par là ,soumettre l'insertion d'une nouvelle feulle à une condition bien précise:Si la cellule D5 de la feuille active est vide ,il ne sera pas possible d'insérer une nouvelle feuille (avec un msg informant l'utilisateur lorsqu'il tente d'insérer une nouvelle feuille sans saisir dans D5).
Actuellement ,lorsque j'insère une nouvelle feuille sans saisir dans D5, Excel n'insère pas la bonne feuille...Pour moi c'est simple car je suis le propriétaire du classeur et du coup j'ai trouvé comment me débrouiller(un peu long à expliquer!).Mais mon classeur est à la disposition d'autres personnes...Si quelqu'un oublie de saisir dans D5 et bien lorsqu'il insèrera une nouvelle feuille il sera surpris d'avoir une feuille vièrge en face de lui .
Voici la macro de création de feuille que j'ai dans workbook

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
Private Sub Workbook_NewSheet(ByVal Sh As Object)
Dim wb As Workbook, wshn As Worksheet, wsha As Worksheet, i%, d As Date
On Error GoTo fin
Set wb = ThisWorkbook
'On vérifie l'existence d'une feuille nommée 'EnCours' dans le classeur.
'Si elle existe, on affecte cette feuille à la variable feuille wsha
'et le contenu de la cellule D5 de cette feuille à la variable d
'puis on renomme la feuille selon d
With wb
For i = 1 To .Worksheets.Count
If .Worksheets(i).Name = "EnCours" Then
Set wsha = .Worksheets(i)
d = wsha.Range("D5").Value
wsha.Name = Format(d, "dd-mm-yy")
Exit For
End If
Next i
End With
 
With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With
'Ici (on est dans le code préexistant) la création de feuille étant effectuée selon la procédure normale
'd'Excel, on utilise une procédure évènementielle (celle-ci !) déclenchée par l'évènement ajout de feuille
'dans le classeur: on supprime la feuille ainsi créée pour lui substituer une copie de la feuille 'Modèle'
'conservée masquée dans le classeur.
Sh.Delete
With Feuil1
.Visible = True
.Copy After:=wb.Worksheets(wb.Worksheets.Count)
.Visible = xlSheetVeryHidden
End With
'On affecte l'objet feuille (copie de la feuille 'Modèle' à la variable feuille wshn
'et on renomme cette feuille pour la retrouver plus facilement par la suite
Set wshn = ActiveSheet
wshn.Name = "EnCours"
'On insère dans la nouvelle feuille une formule dans la plage D8:D54.
'La formule: ='NomFeuillePrécédente'!J8
'est celle insérée dans la cellule D8 de la nouvelle feuille, elle sera copiée sur l'ensemble de la plage
'avec la ligne correspondante (9 à 54), la référence de ligne étant une référence relative.
'NB: noter les apostrophes encadrant le nom de feuille dans la formule (formé à partir de d),
'ces apostrophes sont inidspensables pour que la formule soit fonctionnelle.
If d > 0 Then
wshn.Range("D8:D54").FormulaLocal = "='" & Format(d, "dd-mm-yy") & "'!J8"
End If
fin:
With Application
.CutCopyMode = False
.ScreenUpdating = True
.DisplayAlerts = True
End With
End Sub

On m'a conseillé ceci :

1) la ligne suivante à l'intérieur de la boucle for... next du début

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

If d > 0 Then wsha.Name = Format(d, "dd-mm-yy")

2) Avant l'étiquette fin:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
If d > 0 Then
wshn.Name = "EnCours"
wshn.Range("D8:D54").FormulaLocal = "='" & Format(d, "dd-mm-yy") & "'!J8"
Else
wshn.Delete
End If

Mais ça ne marche pas .Peut-être qu'il manque un petit quelque chose.
Merci de votre aide

Merci de votre aide

[jp014]

Bonjour mobiclick

Une autre approche pour résoudre le problème.

Dans ThisWorkbook création d'un menu avec une option.
Le menu est supprimé quand on ferme le classeur.
Une procédure qui supprime toute feuilles crées.
Un sémaphore (flag) permet de sortir de cette procédure sans effacer la feuille.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
Sub Workbook_BeforeClose(Cancel As Boolean)
Suppr_Menu
Suppr_Menu ' supprimer le menu
 
End Sub
 
Private Sub Workbook_NewSheet(ByVal Sh As Object)
If flag = True Then Exit Sub
'
 
Application.DisplayAlerts = False 'interdit les messages d'avertissements
Application.EnableEvents = False
 
Sh.Delete
 
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.DisplayAlerts = True
 
 
 
End Sub
 
Private Sub Workbook_Open()
 
Creer_Menu
Sheets("Feuil1").Select
 
End Sub

Création du menu et suppression du menu

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
Dans les modules
'***********************************
' a modifier pour le nom du menu
'***********************************
Public Const nommenu As String = "Insertion2"
 
'---------------------------------------------------------------------------------------
' Module    : menu
' DateTime  : 17/04/2006 13:26
' Purpose   : créer le menu
'---------------------------------------------------------------------------------------
 
 
Sub Creer_Menu()
Dim NewMenu As CommandBarPopup
Dim NewSubMenu As CommandBarPopup
Dim NewButton As CommandBarButton
 
' menus d'Excel
nombarre = "Worksheet menu bar"
 
'ajouter un menu
Set NewMenu = Application.CommandBars(nombarre).Controls.Add _
(Type:=msoControlPopup)
NewMenu.Caption = nommenu
' 'ajouter un bouton au menu
 Set NewButton = NewMenu.Controls.Add(Type:=msoControlButton)
 
 With NewButton
 .Caption = "Nouvelle feuille"
 '.BeginGroup = True
 '.FaceId = 
 .OnAction = "nouvellefeuille"
 End With
 
 
End Sub
 
' supprimer le menu
Sub Suppr_Menu()
nombarre = "Worksheet menu bar"
On Error Resume Next
Set NewMenu = Application.CommandBars(nombarre).Controls(nommenu)
NewMenu.Delete
End Sub

Code pour créer la feuille.
On teste la cellule D5 de la feuille active
Dans cette procédure on positionne le drapeau à true ce qui évitera que la feuille crée soit détruite.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
Option Explicit
Public flag As Boolean
Sub nouvellefeuille()
With Sheets(ActiveSheet.Name)
    If .Range("d5") <> "" Then
    flag = True
    ActiveWorkbook.Sheets.Add Before:=Worksheets(Worksheets.Count)
    End If
    flag = False
End With
End Sub

JP014