[Actualité] VBA Excel - Comment incrémenter le nom d’une feuille Excel lorsqu’il existe déjà ?
par
, 08/05/2023 à 19h40 (4384 Affichages)
Préambule
Lors d’une formation "VBA pour excel" que je dispensais il y a un certain temps, une participante m’avait posé une question intéressante "Comment incrémenter le nom d'une feuille, si celui-ci existe déjà ?".
C'est le sujet de ce billet.
Créer une feuille et la renommer
Lorsque l’on crée dynamiquement une feuille dans un classeur Excel à l’aide de l’instruction Worksheets.Add et que l’on souhaite lui attribuer un nom particulier, par exemple le texte "CA" suivi de l’année et du numéro du mois en cours soit ActiveSheet.Name = "CA " & Format(Date, "yyyy-mm"), il est possible que ce nom existe déjà et dans ce cas une erreur 1004 sera levée (Message : Erreur 1004 - Renommer une feuille
Nous pourrions intercepter l’erreur en l’ignorant, comme l’illustre le code ci-dessous, ce qui aura pour effet d’éviter l’affichage du message d’erreur mais qui nous laissera la feuille récemment créée avec son nom incrémenté comme par exemple Feuil7, Sheet7 ou autres, suivant la langue de l’interface.
Code VBA : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3 On Error Resume Next ' Va a l'instruction suivante si erreur ActiveSheet.Name = "CA " & Format(Date, "yyyy-mm") On Error GoTo 0 ' Rend la main au code VBA
Pour éviter cet inconvénient, nous pourrions supprimer la feuille si le numéro de l'erreur levée est égal à 1004
Cependant, la suppression d’une feuille engendre l’affichage du messagePour éviter l’affichage de celui-ci, nous ajouterons l’instruction Application.DisplayAlerts = False, juste avant l’instruction de suppression. Soit le code completMicrosoft Excel supprimera définitivement cette feuille, voulez-vous continuer
Code VBA : 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 Sub cmdRunAddSheet_Click() Dim SheetName As String Dim e As Long SheetName = "CA " & Format(Date, "yyyy-mm") Worksheets.Add ' Ajoute une feuille On Error Resume Next ActiveSheet.Name = SheetName ' Renomme la feuille e = Err.Number On Error GoTo 0 If e = 1004 Then ' Si l'erreur = 1004 With Application .DisplayAlerts = False ActiveSheet.Delete ' Supprime la feuille .DisplayAlerts = True End With End If End Sub
Comment incrémenter le nom, s’il existe déjà ?
L'autre solution est d'incrémenter le nom, c'était le but de l'écriture de ce billet.
Dans notre exemple, nous avons choisi comme nom le mot CA suivi de l’année et du numéro du mois ce qui donne au moment de la rédaction de ce billet CA 2023-05 et comme nous parlons d'incrémentation, l’idée est donc d’avoir CA 2023-05 si le nom n'existe pas et ensuite CA 2023-05_1, CA 2023-05_2, etc.
La ligne de code pour la création du nom incrémenté est : ActiveSheet.Name = "CA " & Format(Date, "yyyy-mm") & "_" & Counter
Counter étant la variable contenant le n° incrémenté.
Pour réaliser cela, nous allons gérer l’erreur en utilisant l’instruction GoTo qui renverra à une étiquette nommée ErrHandler à la place de l’instruction Resume Next
L'instruction On Error GoTo ErrHandler, renvoie à l'étiquette ErrHandler en cas de levée d'erreur
Traitement de l’erreur
Dans cette procédure, nous vérifions que le numéro de l’erreur est bien 1004 et dans l’affirmative nous allons incrémenter la variable Counter et dans le cas contraire, un message doit s’afficher pour indiquer le numéro et la description de cette erreur. C’est une précaution qui permet de ne pas masquer un problème éventuel.
Code de la fonction
Code VBA : 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 Function AddSheet(NewName As String) As Long ' Ajoute une feuille au classeur, la renomme et ajoute une incrémentation si la feuille existe déjà ' La fonction renvoie ' Philippe Tulliez (https://magicoffice.be) Dim Counter As Integer With Worksheets .Add After:=Worksheets(.Count) ' Ajoute une feuille End With ' Renomme la feuille On Error GoTo ErrHandler ' Renvoie à l'étiquette ErrHandler si Erreur ActiveSheet.Name = NewName & IIf(Counter, "_" & Counter, "") On Error GoTo 0 ' Rend la main au VBA ErrHandler: With Err Select Case .Number Case 1004 Counter = Counter + 1 ' Incrémentation du compteur Resume Case Else AddSheet = .Number ' Renvoi le n° d'erreur End Select End With End Function
Exemple d'une procédure qui l'invoque
Code VBA : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6 Sub TestAction_AddSheet() Dim n As String, r As Long n = "CA " & Format(Date, "yyyy-mm") r = AddSheet(n) If r Then MsgBox "Erreur " & r & " à la création de la feuille " & n End Sub
Procédure plus complète
Cette fonction qui porte le même nom a deux arguments et n'incrémente le nom qu'à condition de passer la valeur True à l'argument optionnel WithIncrementing
C'est cette procédure qui est utilisée dans le classeur à télécharger
Code de la procédure
Code VBA : 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 Function AddSheet(NewName As String, Optional WithIncrementing As Boolean) As Variant ' Procédure de création de feuille, nommage de celle-ci ' et incrémentation de son mom, s'il existe ' Arguments ' NewName Nom à attribuer à la feuille ' [WithIncrementing] True si l'incrémentation doit se faire ' False (d:$si dans ce cas la feuille sera supprimée ' La procédure renvoie ' True si la création de la feuille a eu lieu ' False dans le cas contraire ' ou un n° d'erreur si une erreur autre que 1004 devrait avoir été levée Dim Counter As Integer ' Ajoute une feuille With Worksheets: .Add After:=Worksheets(.Count): End With ' Renomme la feuille On Error GoTo ErrHandler ' Renvoie à l'étiquette ErrHandler si Erreur ActiveSheet.Name = NewName & IIf(Counter, "_" & Counter, "") On Error GoTo 0 ' Rend la main au VBA ErrHandler: ' Traitement des erreurs Select Case Err.Number Case 1004 If WithIncrementing Then Counter = Counter + 1 ' Incrémentation du compteur Resume Else With Application .DisplayAlerts = False ActiveSheet.Delete .DisplayAlerts = True End With AddSheet = False End If Case 0: AddSheet = True Case Else: AddSheet = Err.Number End Select End Function
Tutoriel en rapport avec le sujet
Classeur à télécharger