VBA:Excel2007: Renommer une feuille si déjà existante

Résolu/Fermé
cs_douda06 Messages postés 67 Date d'inscription jeudi 25 octobre 2007 Statut Membre Dernière intervention 1 avril 2015 - Modifié par pijaku le 23/07/2014 à 08:44
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 - 23 juil. 2014 à 15:26
Bonjour,

J'ai une macro qui permet de générer des feuilles à partir des labels de colonnes.
Je voudrai qu'avant la création de la feuille et l'attribution de son nom que je fasse une vérification si le nom de la feuille existe déjà qu'on y ajoute un chiffre devant,
Par exemple: les colonnes ABC | BCD | ZEE
si j'exécute la première fois j'aurai les feuilles ABC1 | BCD1 | ZEE1
si j'exécute la deuxième fois j'aurai les feuilles ABC2 | BCD2 | ZEE2

Car pour l'instant ça marche pour la 1ère exécution, mais à la 2ème exécution ça m'affiche Sheet (1) | Sheet (2) | Sheet (3)

Voici une partie du code qui fait l'affaire:
'-----------------------------------------------------------------
Option Explicit
Option Base 1

Const TEMPLATE As String = "TempM" 
Const Cpt As Integer = 1

Sub GenererFeuil()

Dim LinFin As Byte, T_base As Byte, Cptr_test As Byte
Dim Entete As Range, Nbre_chx As Byte, Chx As Byte, Tot As String, TotIdx As Byte
Dim MyRange As Range
Dim Col_num As Integer    
Dim ws As Worksheet
Dim nwSh As Worksheet
Dim Nbcolm As Long
Set ws = Sheets(4)
Nbcolm = colm - 5
                
Application.ScreenUpdating = False

        With Sheets(4)

             LinFin = Sheets(4).Columns("A").Find("*", , , , , xlPrevious).Row

                 T_base = Sheets(4).Range(.Cells(2, 1), Sheets(4).Cells(LinFin , 5 + Nbcolm))
                     For Chx = 1 To Nbcolm
                         
                            'Copie du contenu de tempM ds nelles feuilles
                            Sheets(TEMPLATE).Copy After:=Sheets(Sheets.Count)
                            Set nwSh = ActiveSheet
                            
                            On Error Resume Next
                               'Ici les noms des feuilles sont attribués depuis la col 5 de la feuille4
                                nwSh.Name = (ws.Cells(1, 5 + Chx).Value)
 
 '================> ici je souhaite créer la condition pour 
'vérifier si le nom de la feuille existe déjà dans le classeur et si 
'ça existe qu'il ajoute un nombre apres le nom.



Est ce que quelqu'un peut m'aider SVP?
Merci d'avance :)

1 réponse

pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 744
23 juil. 2014 à 08:43
Bonjour,

C'est un peu plus complexe que cela.
Tu dois :
Vérifier si le nom existe déjà.
- si oui, vérifier que ce nom se termine par une partie numérique,
=> si oui,
* extraire cette partie numérique (qui pourrait avoir plusieurs chiffres ex : ZEE13)
* ajouter 1 à ce nombre
* renommer la feuille
=> si non : ajouter 1 après le nom de la feuille
- si non, renommer simplement la feuille

Pour cela, tu peux te faire une petite fonction personnalisée avec deux paramètres : le classeur et le nom de la feuille.
Comme point de départ, je te propose la fonction FeuilleExiste de Bbil :

Function FeuilleExiste(wk As Workbook, stFeuille) As Boolean
 On Error Resume Next
 FeuilleExiste = Not (wk.Sheets(stFeuille) Is Nothing)
End Function


Que l'on peut transformer afin qu'elle retourne un String plutôt qu'un Boolean :

Function RenommeFeuille(wk As Workbook, stFeuille As String) As String
 On Error Resume Next
 If Not (wk.Sheets(stFeuille) Is Nothing) Then
   RenommeFeuille = "Ta feuille existe déjà"
 Else
   RenommeFeuille = "Ta feuille n'existe pas encore"
 End If
End Function


Reste à y ajouter les différentes conditions que je t'ai détaillé plus haut.


L'appel de cette fonction personnalisée se ferait depuis ta procédure principale comme ceci :

'
Dim AncienNom As String
'[
'...
']
Sheets(TEMPLATE).Copy After:=Sheets(Sheets.Count)
Set nwSh = ActiveSheet
'Ici les noms des feuilles sont attribués depuis la col 5 de la feuille4
AncienNom = ws.Cells(1, 5 + Chx).Value
On Error Resume Next
nwSh.Name = RenommeFeuille(ThisWorkbook, AncienNom)
End Sub
1
cs_douda06 Messages postés 67 Date d'inscription jeudi 25 octobre 2007 Statut Membre Dernière intervention 1 avril 2015
23 juil. 2014 à 12:28
Bonjour Franck,
Merci, j'ai testé ton code, mais ça me donne toujours le même résultat :(
J'ai modifié la function RenommeFeuille, en ajoutant un "_" au nom de la feuille s'il existe déjà; mais si j'exécute une deuxième fois ça ne renomme pas la feuille et ça continue à m'afficher les TempM (1) | TempM (2) | TempM (3) .. (parce qu'il copie le même contenu de la feuille TEMPLATE) !

Est ce qu'il faut peut être ajouter l'appel à cette fonction dans une boucle? pour qu'a chaque exécution, la macro attribue les mêmes noms de colonnes aux feuilles (en y ajoutant après un chiffre qui s'incrémente pour chaque exécution ) ? Sinon peux tu me proposer une solution plus appropriée? Merci bcp
0
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 744
23 juil. 2014 à 12:32
Hum hum...
Le code donné n'est pas complet, et je l'ai précisé :
Reste à y ajouter les différentes conditions que je t'ai détaillé plus haut.
.......

Pour rappel :
Vérifier si le nom existe déjà. '=> fait par mon code
- si oui, vérifier que ce nom se termine par une partie numérique, ' => pas fait
=> si oui, '=> pas fait
* extraire cette partie numérique (qui pourrait avoir plusieurs chiffres ex : ZEE13)
* ajouter 1 à ce nombre
* renommer la feuille
=> si non : ajouter 1 après le nom de la feuille '=> pas fait
- si non, renommer simplement la feuille

S'il le faut, je le ferais, mais ça serait cool que tu tentes quelque chose...
0
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 744
23 juil. 2014 à 12:50
Peut être comme ceci (sans garantie, pas testé) :

Function RenommeFeuille(wk As Workbook, Feuille As String) As String
Dim Ws As Worksheet, NbFeuilMemeSuffixe As Integer

For Each Ws In wk.Worksheets
    If Left(Ws.Name, Len(Feuille)) = Feuille Then
        NbFeuilMemeSuffixe = NbFeuilMemeSuffixe + 1
    End If
Next Ws
RenommeFeuille = Feuille & NbFeuilMemeSuffixe
End Function
0
cs_douda06 Messages postés 67 Date d'inscription jeudi 25 octobre 2007 Statut Membre Dernière intervention 1 avril 2015
23 juil. 2014 à 13:18
eeeeeee :S c'est la partie qui m'est la plus compliquée ...
alors j'ai ajouté un compteur qui s'incrémente au nom de la feuille :

Function RenommeFeuille(wk As Workbook, stFeuille As String) As String
On Error Resume Next
If Not (wk.Sheets(stFeuille) Is Nothing) Then
RenommeFeuille = stFeuille & Cpt + 1
Else
RenommeFeuille = stFeuille
End If
End Function

Ensuite j'ai ajouté une condition:

If FeuilleExiste = True Then ' LA ça ME DONNE ERREUR "Argument non facultatif"
AncienNom = ws.Cells(1, 5 + Chx).Value
On Error Resume Next
nwSh.Name = RenommeFeuille(ThisWorkbook, AncienNom)
End If

Vérifier que ce nom se termine par une partie numérique (...)= ça je n'ai aucune idée de comment le faire :S
0
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 744
23 juil. 2014 à 13:20
0