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
| Dim NomFichier, Chemin As String 'Déclarations des variables en chaînes de caractères
Dim wk As Workbook 'Déclaration d'une variable en objet WorkBook, soit Classeur Excel
Dim ws As Worksheet 'Déclaration d'une variable en objet Worksheet, soit Feuille de Calcul Excel
If (Sheets.Count = 2) Then
reponse = MsgBox("Vous n'avez fait aucun traitement !", vbInformation, "INFORMATION")
'=>Message d'erreur adressé à l'utilisateur
Exit Sub 'Sortie forcée de la fonction
End If
NbFeuille = Worksheets.Count 'Affectation du nombre de feuilles de calcul contenues dans le classeur affecté à la variable NbFeuille
NomFeuille = Sheets(3).Name 'Le nom du fichier vaut celui de la feuille de calcul située en 3ème position
Chemin = TB_Repertoire & "\" 'Affectation, par l'utilisateur via la TextBox, l'emplacement du dossier où les fichiers.txt sont situés
If TB_Sauvegarde = "" Then 'SI le répertoire (Chemin) est nulle, alors :
rep = MsgBox("Vous n'avez pas indiqué l'emplacement du/des fichier(s) créé(s) !", vbInformation, "INFORMATION")
'=> Message d'erreur pour l'utilisateur
End If
If NbFeuille > 3 Then 'SI il y a plus de 3 feuilles contenues dans le classeur, alors :
'=> CAS POUR LE TRAITEMENT DE PLUSIEURS FICHIERS
Flag1: 'Retour suite au GoTo
Question = InputBox("Veuillez indiquer le nom du fichier.xls qui regroupera toutes les données.", "INFORMATION", "LIEU_EcluseN° ou Nom_Tables_Animation")
'=> Question adressée à l'utilisateur pour affecter le nom du fichier.xls à enregister
If Question = vbCancel Then Exit Sub 'SI clique sur le bouton annuler, alors : sortie forcée de la fonction
If Question = "" Or Question = "Lieu_EcluseN° ou Nom_Tables_Animation" Or Not (Question Like "*_*" & "*_Tables_Animation") Then 'SI le nom n'est pas conforme, alors :
MsgBox "Vous n'avez pas ou mal renseigné le nom de votre Claseur Excel !"
'=> Message d'erreur adressé à l'utilisateur
GoTo Flag1 'Création d'un branchement conditionnel : Renvoie 4 lignes auparavant (Ligne avec "Flag1")
Else
NomFichier = Question & ".xls" 'La réponse donnée par l'utilisateur est affectée à la variable NomFichier
NomFeuille = Question
End If
End If
If (Sheets.Count = 3) Then 'Vérification de la présennce de données => CAS POUR LE TRAITEMENT D'UN SEUL FICHIER
Set ws = ThisWorkbook.Sheets(NomFeuille) 'Selection la feuille qui sera copiée dans le classeur de traitement
Set wk = Workbooks.Add(xlWBATWorksheet) 'Création d'un nouveau Classeur Excel avec une feuille
NomFichier = ws.Name & ".xls" 'Affectation du nom du nouveau classeur pour le sauvegarder en .xls
Chemin = TB_Sauvegarde & "\" 'Affectation de l'emplacement (Chemin), avec la TextBox, pour sauvegarder le NOUVEAU classeur contenant plusieurs feuilles de calcul
wk.Sheets(1).Name = NomFeuille 'Renomme la feuille par défaut
wk.SaveAs FileName:=Chemin & NomFichier 'Sauvegarde du fichier renommé dans le repertoire voulu
ws.Cells.Copy wk.Sheets(NomFeuille).Range("A1") 'Copie les données traitées par EXTRACT_TAG.xls dans la feuille nommée du nouveau Classeur
rep = MsgBox("Le fichier << " & NomFichier & " >> a bien été enregistré !" & Chr(10) & Chr(10) & "Le répertoire essocié est << " & Chemin & " >>.", vbYes + vbInformation, "Enregistrement...")
'=> Message d'information pour l'utilisateur
wk.Close True 'Fermeture du NOUVEAU classeur Excel avec une 2nd sauvegarde
Question = MsgBox("Voulez-vous ouvrir l'emplacement du/des fichier(s) créé(s) ?", vbYesNo + vbInformation, "INFORMATION")
'=> Question adressée à l'utilisateur pour ouvrir ou non l'emplacement du fichier.xls créé
If Question = vbYes Then 'SI la réponse à la Question est OUI, alors :
Shell "explorer.exe " & Chemin, vbMaximizedFocus 'Ouverture du répertoire associé au classeur créé dans une fenêtre Windows maximisée au premier plan
End If
If Question = vbNon Then 'SI la réponse à la Question est NON, alors :
Exit Sub 'Ne rien faire => Sortie forcée de la fonction
End If
Else
reponse = MsgBox("Vous n'avez fait aucun traitement !", vbInformation, "INFORMATION")
'=>Message d'erreur adressé à l'utilisateur
Exit Sub 'Sortie forcée de la fonction
End If
Application.DisplayAlerts = False 'Inhibition des alertes Excel
If NbFeuille >= 2 Then 'Si le nombre de feuille de calcul présent dans le classeur d'extraction est > ou = à 2, alors :
For x = 1 To NbFeuille - 1 'Faire autant de fois qu'il faut, pour que NbFeuille < 2 :
Sheets(2).Delete 'Suppression des Feuilles inutiles
Next
End If
Application.DisplayAlerts = True 'Réactivation des alertes Excel
Set NewFeuille = Sheets.Add(After:=Sheets("EXTRACT")) 'Création d'une nouvelle feuille situé après la feuille EXTRACT
NewFeuille.Name = "DONNEES" 'Nomme la nouvelle feuille
Set NewFeuille = Nothing 'Libère l'Objet NewFeuille
ActiveWorkbook.Worksheets("EXTRACT").Select 'Affiche au premier plan la feuille de calcul EXTRACT |
Erreur lors de la copie d'une feuille vers un autre classeur qui vient d'être créé
Répondre avec citation
Envoyé par gnain
Partager