Bonjour le forum,

Dans la macro ci-dessous l'utilisateur peut copier une feuille d'un fichier vers un autre fichier en ayant la possibilité de renommer l'onglet de la feuille copiée dans le fichier archive. Voir ci dessous


Code : 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
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
      ' Macro utilisée pour enregistrer l'analyse de risque dans le fichier HISTO.xls
Sub EnrHisto()
nom_du_fichier_initial = ActiveWorkbook.Name
'Supprime les caractères .XLS
nom_du_fichier = Left(nom_du_fichier_initial, _
                            Len(nom_du_fichier_initial) - 4)
nom_du_fichier = UCase(nom_du_fichier)
 
'----------------
If Right(nom_du_fichier, 5) = "HISTO" Then
    nom_du_fichier = Left(nom_du_fichier, _
                            Len(nom_du_fichier) - 6)
    nom_du_fichier = nom_du_fichier + ".xls"
    position_onglet = 2
    ' Supprime les boutons
 
Else
    nom_du_fichier = nom_du_fichier + " HISTO.xls"
    position_onglet = 1
 
End If
nom_fiche_active = ActiveSheet.Name
 
If nom_fiche_active <> "Fiche prépa" Then
    Msg = "VOUS N'ETES PAS SUR VOTRE ANALYSE DE RISQUE!!"
    Title = "Attention ERREUR!!!!!"   ' Définit les titres.
    ' Affiche le message.
    Réponse = MsgBox(Msg, Style, Title)
Else
    Réponse = 7
End If
 
On Error GoTo Affichage_message_erreur
 
Select Case Réponse
Case 7
    Sheets(nom_fiche_active).Copy Before:=Workbooks( _
        nom_du_fichier).Sheets(position_onglet)
 
Case 6
    nombre_de_feuille = Sheets.Count
    If nombre_de_feuille > 1 Then
        Sheets(nom_fiche_active).Move Before:=Workbooks( _
            nom_du_fichier).Sheets(position_onglet)
    Else
        Msg = "Il n'est pas possible de déplacer une feuille seule" & Chr(13) & _
                "Pour la transférer, choisissez : COPIER"
        Style = vbOK + vbExclamation  ' Définit les boutons.
        Title = "Erreur mineure"   ' Définit les titres.
        ' Affiche le message.
        Réponse = MsgBox(Msg, Style, Title)
    End If
Case Else
    Windows(nom_du_fichier_initial).Activate
    On Error GoTo 0
    Exit Sub
End Select
 
On Error GoTo 0
 
If nom_fiche_active = "Fiche prépa" Then
    'Affiche message : nom de la feuille
    Msg = "Vous enregistrez votre analyse de risque dans le fichier HISTO. Veuillez lui donner un nom!!!"
    Title = "Copie de l'analyse de risque dans un autre fichier"   ' Définit les titres.
    Réponse = InputBox(Msg, Title)
    If Réponse = "" Then
        Windows(nom_du_fichier_initial).Activate
        Exit Sub
    End If
    Sheets(position_onglet).Name = Réponse
End If
 
Windows(nom_du_fichier_initial).Activate
Exit Sub
 
Affichage_message_erreur:
    Msg = "Le fichier de copie n'a pas été trouvé."
    Style = vbOKOnly + vbExclamation  ' Définit les boutons.
    Title = "Erreur pénalisante"   ' Définit les titres.
    ' Affiche le message.
    Réponse = MsgBox(Msg, Style, Title)
    Exit Sub
Resume
 
End Sub
Tout cela fonctionne bien, mais je souhaiterais éviter que l'utilisateur ne puisse pas enregistrer deux feuilles différentes avec le même nom et qu'il ne puisse saisir un nom qu'avec 31 caractères maximum. Pour éviter le débogage dans les deux cas.

Merci pour votre aide

Cordialement