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
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
| Dim NomFeuilleExcel As String
Dim NomFichierExcel As Variant
Dim NomCheminFichierExcel As Variant
Dim Antislash As String
Dim wkb As Excel.Workbook
Dim wks As Excel.Worksheet
Dim ObjXl As Excel.Application
' Pour que Excel.workbook, etc. apparaissent dans la liste de déclaration, il faut aller auparavant dans Menu/Tool.Reference et sélectionner Microsoft Excel Object library
NomFichierExcel = GetExcelFile
' La fonction GetExcelFile va me permettre de récupérer le fichier Excel qui est mis ensuite dans la chaîne de caractère NomdeFichierExcel
' Voici la Fonction renvoyée en module
Public Function GetExcelFile()
Set fDialog = Application.FileDialog(3)
' Pour que Filedialog apparaisse dans la liste, il faut aller auparavant dans Menu/Tool.Reference et sélectionner Microsoft Office Object Library
With fDialog
.AllowMultiSelect = False
' Ici, on ne veut qu'un seul choix possible
.Title = "Please select Excel file to import"
' Ici on met le titre de la boite de recherche
.Filters.Clear
' Ici on enlève les éventuels filtres d'extension
.Filters.Add "Sélectionnez le Dashboard", "*.xlsm,*.xlx,*.xlsx"
' Ici on paramètre les extensions de fichiers que l'on veut permettre
If .Show = True Then
GetExcelFile = .SelectedItems(1)
' Ici on renseigne GetExcelFile seulement si l'usager à sélectionné un fichier
Else
GetExcelFile = Null
End If
End With
End Function
' Ce code n'est pas de moi, je l'ai adapté de... Je ne sais plus, je ne l'ai pas noté. gloire à l'auteur donc
' Ci dessous, la suite du code que l'on avait laissé le temps d'expliciter la fonction appelée
If IsNull(NomFichierExcel) = True Then
MsgBox ("Veuillez sélectionner un fichier Excel")
Exit Sub
End If
' Le code ci-dessus permet de sortir de la procédure si aucun fichier n'est sélectionné
Antislash = "\"
NomCheminFichierExcel = GetExcelPath(NomFichierExcel, Antislash) & "MonDashboard"
' La fonction publique GetExcelPath permet de récupérer le chemin du fichier sélectionné via GetExcelFile et de rajouter le nom Mondashboard, Mondashboard ce sera le nom de mon fichier csv
' Là encore, je la met à la suite, tout en sachant que c'est en fait un module
Public Function GetExcelPath(Chemin As Variant, Antislash As Variant) As Variant
' Chemin est le chemin complet du fichier excel, y compris son nom, et Antislash est l'antislash du chemin avant le nom du fichier excel)
Dim position As Integer
position = InStr(1, StrReverse(Chemin), Antislash)
' Ci-dessus, on a inversé l'écriture de Chemin et l'on cherche la position du premier antislash qui est le dernier dans l'écriture du chemin à l'endroit
position = Len(Chemin) - position + 1
' On soustrait de la longueur du chemin la portion avant le dernier antislash
' On a alors le nombre de caractère contenu dans le chemin du dossier contenant le fichier Excel
GetExcelPath = Left(Chemin, position)
' et on récupère ce chemin en le coupant juste avant la mention du nom du ficher Excel de NomFichierExcel identifié par Chemin dans la fonction
End Function
' Retour au code de la private sub du bouton du formulaire
Set ObjXl = New Excel.Application
ObjXl.Visible = False
ObjXl.UserControl = False
' Le code ci-dessus ouvre Excel mais ne le montre pas à l'usager
Set wkb = ObjXl.Workbooks.Open(NomFichierExcel)
' Ce code sélectionne le fichier dont on a récupéré le chemin (NomFichierExcel)
For Each wks In wkb.Worksheets
If wks.Index = 2 Then
wks.SaveAs NomCheminFichierExcel, 23, True
End If
Next
' Le code ci-dessus va chercher la deuxième feuille du fichier Excel et l'enregistrer sous le nom MonDashboard au même endroit que le fichier Excel initial au format csv
Set wks = Nothing
wkb.Close
Set wkb = Nothing
ObjXl.Quit
Set ObjXl = Nothing
' Le code ci-dessus ferme ensuite le fichier Excel ouvert
NomFichierExcel = NomCheminFichierExcel & ".csv"
' On reprend le chemin du fichier csv
DoCmd.TransferText acImportDelim, , "MontableaudeBord", NomFichierExcel, True
' Puis on importe le fichier csv créé
On Error Resume Next
Kill NomFichierExcel
On Error GoTo 0 |
