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 54 55 56 57
| 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
If d > 0 Then 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
'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.Name = "EnCours"
wshn.Range("D8:D54").FormulaLocal = "='" & Format(d, "dd-mm-yy") & "'!J8"
Else
wshn.Delete
MsgBox "Veuillez saisir la date dans (D5) et/ou renommer la feuille en lui donnant le nom (EnCours)."
End If
wshn.Protect "motdepasse"
fin:
With Application
.CutCopyMode = False
.ScreenUpdating = True
.DisplayAlerts = True
End With
End Sub |
Partager