XL 2019 Récupérer le automatiquement le nom d'une feuille récemment créée

scrib

XLDnaute Nouveau
Bonjour à tout le forum,

Pour faire une archive d'une feuille xl, j'ai créé un bouton qui permet de le faire et de renommer la feuille nouvellement créée. J'aimerais pouvoir retrouver le nom de cette nouvelle feuille automatiquement. Depuis plusieurs jours, je planche sur ce problème et aucune solution ne fonctionne. Je vous joints un petit fichier txt de mon code pour plus de clarté.

VB:
Private Sub BT_Archive_Click()
    Archive = MsgBox("Voulez-vous vraiment archiver cette feuille?", vbYesNo, "Archive de l'année passée")
    If (Archive = vbNo) Then
        Exit Sub
    Else
        Nouveau_Nom = InputBox("Donnez un nom à cette archive", "Renommer", vbOKOnly)
        If Nouveau_Nom = "" Then
            Exit Sub
        Else
            Sheets("Suivi année en cours").Activate
            ActiveSheet.Copy after:=Sheets("Suivi année en cours")
        End If
    End If
    ActiveSheet.Name = Nouveau_Nom
    Histo = MsgBox("Voulez-vous aussi archiver l'historique?", vbYesNo, "Archive de l'historique")
    If (Histo = vbNo) Then
        Exit Sub
    Else
    ' Ici je dois recupérer le nom nom de la feuille renommée
    'pour y inclure une copie d'une autre feuille XL
    End if

End Sub

Merci pour vos futures réponses.
Scrib
 
Solution
Re

Une version un peu améliorée
VB:
Private Sub BT_Archive_Click()
Dim f_Nom$
archive = MsgBox("Voulez-vous vraiment archiver cette feuille?", vbYesNo, "Archive de l'année passée")
Select Case archive
Case 6
Nouveau_Nom = InputBox("Donnez un nom à cette archive", "Renommer", "Copie_")
If StrPtr(Nouveau_Nom) = 0 Then
MsgBox "Archivage annulé", vbExclamation
Exit Sub
ElseIf Nouveau_Nom = vbNullString Then
MsgBox "Vous n'avez pas saisi de nom pour l'archive!", vbCritical
Exit Sub
Else
f_Nom = Nouveau_Nom
End If
Case 7
Exit Sub
End Select
Sheets("Suivi année en cours").Copy after:=Sheets("Suivi année en cours")
ActiveSheet.Name = f_Nom
End Sub
Fais les tests suivants
1) clique sur Annuler
2) Clique sur OK en laissant l'InputBox vide...

Staple1600

XLDnaute Barbatruc
Bonsoir le fil, ReBonsoir scrib

=>scrib
Je reposte mon message au bon endroit ;)
Un début de piste (qu'il faudra peaufiner)
Je te laisse tester pour en trouver les travers
VB:
Private Sub BT_Archive_Click()
archive = MsgBox("Voulez-vous vraiment archiver cette feuille?", vbYesNo, "Archive de l'année passée")
Select Case archive
Case 6
Nouveau_Nom = InputBox("Donnez un nom à cette archive", "Renommer", "Copie_")
Case 7
Exit Sub
End Select
Sheets("Suivi année en cours").Copy after:=Sheets("Suivi année en cours")
ActiveSheet.Name = Nouveau_Nom
End Sub
 
Dernière édition:

scrib

XLDnaute Nouveau
Bonsoir le fil, ReBonsoir scrib

=>scrib
Je reposte mon message au bon endroit ;)
Un début de piste (qu'il faudra peaufiner)
Je te laisse tester pour en trouver les travers
VB:
Private Sub BT_Archive_Click()
archive = MsgBox("Voulez-vous vraiment archiver cette feuille?", vbYesNo, "Archive de l'année passée")
Select Case archive
Case 6
Nouveau_Nom = InputBox("Donnez un nom à cette archive", "Renommer", "Copie_")
Case 7
Exit Sub
End Select
Sheets("Suivi année en cours").Copy after:=Sheets("Suivi année en cours")
ActiveSheet.Name = Nouveau_Nom
End Sub
Bonjour et Merci Staple1600,
Je vais essayé ce code, et je reviens si il y a un problème dont je ne trouve pas la solution.
DB
 

Staple1600

XLDnaute Barbatruc
Re

Une version un peu améliorée
VB:
Private Sub BT_Archive_Click()
Dim f_Nom$
archive = MsgBox("Voulez-vous vraiment archiver cette feuille?", vbYesNo, "Archive de l'année passée")
Select Case archive
Case 6
Nouveau_Nom = InputBox("Donnez un nom à cette archive", "Renommer", "Copie_")
If StrPtr(Nouveau_Nom) = 0 Then
MsgBox "Archivage annulé", vbExclamation
Exit Sub
ElseIf Nouveau_Nom = vbNullString Then
MsgBox "Vous n'avez pas saisi de nom pour l'archive!", vbCritical
Exit Sub
Else
f_Nom = Nouveau_Nom
End If
Case 7
Exit Sub
End Select
Sheets("Suivi année en cours").Copy after:=Sheets("Suivi année en cours")
ActiveSheet.Name = f_Nom
End Sub
Fais les tests suivants
1) clique sur Annuler
2) Clique sur OK en laissant l'InputBox vide.

EDITION:
VB:
Private Sub BT_Archive_Click()
Dim f_Nom$
archive = MsgBox("Voulez-vous vraiment archiver cette feuille?", vbYesNo, "Archive de l'année passée")
Select Case archive
Case 6
Nouveau_Nom = InputBox("Donnez un nom à cette archive", "Renommer", "Copie_")
If StrPtr(Nouveau_Nom) = 0 Then
MsgBox "Archivage annulé", vbExclamation
Exit Sub
ElseIf Nouveau_Nom = vbNullString Then
MsgBox "Vous n'avez pas saisi de nom pour l'archive!", vbCritical
Exit Sub
Else
f_Nom = Nouveau_Nom
End If
Case 7
Exit Sub
End Select
If SheetExists(f_Nom) Then Exit Sub
Sheets("Suivi année en cours").Copy after:=Sheets("Suivi année en cours")
ActiveSheet.Name = f_Nom
End Sub
Function SheetExists(SheetName As String) As Boolean
SheetExists = False
On Error GoTo NoSuchSheet
SheetExists = (Len(Sheets(SheetName).Name) > 0)
NoSuchSheet:
End Function
 
Dernière édition:

scrib

XLDnaute Nouveau
Re

Une version un peu améliorée
VB:
Private Sub BT_Archive_Click()
Dim f_Nom$
archive = MsgBox("Voulez-vous vraiment archiver cette feuille?", vbYesNo, "Archive de l'année passée")
Select Case archive
Case 6
Nouveau_Nom = InputBox("Donnez un nom à cette archive", "Renommer", "Copie_")
If StrPtr(Nouveau_Nom) = 0 Then
MsgBox "Archivage annulé", vbExclamation
Exit Sub
ElseIf Nouveau_Nom = vbNullString Then
MsgBox "Vous n'avez pas saisi de nom pour l'archive!", vbCritical
Exit Sub
Else
f_Nom = Nouveau_Nom
End If
Case 7
Exit Sub
End Select
Sheets("Suivi année en cours").Copy after:=Sheets("Suivi année en cours")
ActiveSheet.Name = f_Nom
End Sub
Fais les tests suivants
1) clique sur Annuler
2) Clique sur OK en laissant l'InputBox vide.

EDITION:
VB:
Private Sub BT_Archive_Click()
Dim f_Nom$
archive = MsgBox("Voulez-vous vraiment archiver cette feuille?", vbYesNo, "Archive de l'année passée")
Select Case archive
Case 6
Nouveau_Nom = InputBox("Donnez un nom à cette archive", "Renommer", "Copie_")
If StrPtr(Nouveau_Nom) = 0 Then
MsgBox "Archivage annulé", vbExclamation
Exit Sub
ElseIf Nouveau_Nom = vbNullString Then
MsgBox "Vous n'avez pas saisi de nom pour l'archive!", vbCritical
Exit Sub
Else
f_Nom = Nouveau_Nom
End If
Case 7
Exit Sub
End Select
If SheetExists(f_Nom) Then Exit Sub
Sheets("Suivi année en cours").Copy after:=Sheets("Suivi année en cours")
ActiveSheet.Name = f_Nom
End Sub
Function SheetExists(SheetName As String) As Boolean
SheetExists = False
On Error GoTo NoSuchSheet
SheetExists = (Len(Sheets(SheetName).Name) > 0)
NoSuchSheet:
End Function
Merci Staple 1600, je vais partir de ce code et le mettre à ma sauce pour qu'il corresponde à mon programme.
 

Discussions similaires

Statistiques des forums

Discussions
311 740
Messages
2 082 047
Membres
101 880
dernier inscrit
Anton_2024