Modification d'une macro

Version imprimable

Bonjour le forum,
Merci à tous les forumeurs pour le merveilleux travail qu'ils accomplissent.
Je souhaiterais améliorer le code de mon workbook mais je ne sais trop comment opérer:

Code:

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

Ma demande est la suivante:
je souhaiterais que ,lorsque je supprime la feuille "EnCours",je ne sois pas obligé de renommer la feuille précédente pour pouvoir insérer une nouvelle feuille.Par exemple que la feuille précédente se renomme automatiquement "EnCours" dès que je supprime la feuille "EnCours".
Merci d'avance

Bonsoir à tous,

comme il n'y a pas d'évènement "surSuppression", il faut se servir de l'activation d'une feuille après la suppression de la feuille "EnCours".
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 Private Sub Workbook_SheetActivate(ByVal Sh As Object) Dim f As Object Dim LastSheet As String Dim EnCours As Boolean LastSheet = "" EnCours = False For Each f In Sheets If UCase(f.Name) = "ENCOURS" Then EnCours = True If f.Name > LastSheet Then LastSheet = f.Name 'Test à voir Next If EnCours = False Then Sheets(LastSheet).Name = "EnCours" End Sub
Reste le problème pour trouver la dernière feuille, la dernière date.
Y-a-t-il d'autres onglets portant d'autres noms que "EnCours" et une date. Une date au format américain "yy-mm-dd" résoudrait directement le problème.

ESVBA

21/01/2010, 20h45
mobiclick

Merci ESVBA
Effectivement ,mon classeur est composé de feuilles dont le nom est sous le format date (dd-mm-yy) sauf la dernière qui se nomme "EnCours".Mon problème c'est que lorsque je supprime "EnCours" ,je dois renommer la feuille précédente (qui est devenue la dernière) en lui donnant le nom "EnCours".Si non je ne peux pas insérer de nouvelle feuille (c'est mon code qui implique ceci). Je voudrais dispenser l'éventuel utilisateur du classeur de renommer cette dernière.Le code que tu m'as donné ne fonctionne pas puisqu'il ne renomme automatiquement pas la feuille précédente lorsque je supprime la feuille nommée "EnCours".
Je crois que tu n'est pas loin ;je suis même content que tu m'ais compris.
PS : s'il je dois apporter de grosses modif à mon code du premier post et bien je suis pret.
Merci

bonsoir,

avec un "CDate(nimportequoicorrespondantaunedate)" ce sera bon avec un petit changement dans l'ordre des "IF" dans la procédure :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    Dim f As Object
    Dim LastSheet As String
    Dim EnCours As Boolean
 
    LastSheet = ""
    EnCours = False
 
    For Each f In Sheets
        If UCase(f.Name) = "ENCOURS" Then
             EnCours = True
        ElseIf f.Name > LastSheet Then
             LastSheet = f.Name
        End IF
    Next
 
    If EnCours = False Then Sheets(LastSheet).Name = "EnCours"
 
End Sub

ESVBA

22/01/2010, 09h25
mobiclick

Bonjour le forum,
merci ESVBA...
Mais je ne sais pas oû placer ce bout de code

Code:

"CDate(nimportequoicorrespondantaunedate)"

merci

Re ,
je viens de remarquer une chose c'est que lorsque je supprime la feuille"EnCours" et bien c'est la première feuille du classeur qui renommée et non la dernière .Désolé...Je ne l'avais pas remarqué avant car elle était masquée.C'est en jettant un coup d'oeuil dans l'éditeur VB que je l'ai remarqué.La première feuille a pour nom "Modèle".Je crois qu'on y est presque?
merci

bonsoir mobiclick,

Citation:

avec un "CDate(nimportequoicorrespondantaunedate)

c'est une manière de parler de la fonction utilisée.
:oops:J'ai oublié de la mettre dans le code.

Pour l'onglet "Modèle", il suffit de l'excluse du traitement.

Cette fois doit être la bonne. Voici le code :

Code:

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
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    '> Version 0.2
 
    Dim f As Object
    Dim LastSheet As String
    Dim EnCours As Boolean
    '--- Initialisation 
    LastSheet = ""
    EnCours = False
    '--- Test des feuilles
    For Each f In Sheets
        '--- Feuille "EnCours" existe encore
        If UCase(f.Name) = "ENCOURS" Then
            EnCours = True   'Existe encore
            Exit For             'Rapidité
        ElseIf f.Name <> "Modèle" Then
            If LastSheet = "" Then LastSheet = f.Name   'C'est forcément un onglet format Date "xx-xx-xx"
            If CDate(f.Name) > CDate(LastSheet) Then    'donc cette fois on peut l'utiliser avec "CDate()"
                LastSheet = f.Name 'Si feuille est plus récente actualise la dernière feuille
            End If
        End If
    Next
    '--- S'il n'est pas sortiy a plus de feuille "EnCours", renomme la dernière feuille
    If EnCours = False Then Sheets(LastSheet).Name = "EnCours"
End Sub

Fonctionne avec la procédure d'ajout de feuilles "_NewSheet()" écrite plus haut.
Si j'ai oublié quelque chose...

ESVBA