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
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.
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
Merci pour votre aide
Cordialement
Partager