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
| Function X1cImportDataXlsx(P$, ff$, wsf$, wst$, r&, c&, Optional mfold$, Optional sfold$, Optional CreateTable As Boolean)
'X1c_046-Importe une feuille de données d'un fichier xlx and une feuille du classeur courant (XlOneClick: G.Charrault)
'Arg 1 = P$ : Parent Path
'Arg 2 = ff$ : Fichier Source
'Arg 3 = wsf$ : Feuille source
'Arg 4 = wst$ : Feuille de destination
'Arg 5 = r& :Ligne de destination
'Arg 6 = c& :Colonne de destination
'Arg 7 = [mfold$] Optional : Répertoire du Parent Path' ? répertoire source ?
'Arg 8 = [sfold$] Optional : Sous répertoire du Parent Path ' ?
'Arg 9 = [CreateTable] Optional : As Boolean Créer une table ListObject
Dim i As Integer
Dim wb As Workbook
Dim ws As Worksheet
Dim Cn As ADODB.Connection
Dim SQLText As String
Dim Rst As ADODB.Recordset ' ?
Dim XlsXfileFrom As String
Dim rgt As Range
X1cTestOrCreateWorksheet ThisWorkbook, wst ' ?
Set wb = ThisWorkbook
Set ws = wb.Worksheets(wst)
'----------Tester les répertoires et sous-répertoires----------------------------------------
If Not mfold = "" Then
If Not sfold = "" Then X1cTestOrCreateSubFolder P, mfold, sfold Else X1cTestOrCreateFolder P, mfold
End If
'------------Batir le chemin complet du fichier-----------------------------------------------
If Not Right(P, 1) = "\" Then P = P & "\"
If Not mfold = "" And Not Right(mfold, 1) = "\" Then mfold = mfold & "\" 'if not mfold = "" ? si le répertoire n'est pas vide ? = if mfold <> "" ?
If Not sfold = "" And Not Right(sfold, 1) = "\" Then sfold = sfold & "\"
If Not UCase(Right(ff, 5)) = ".XLSX" Then ff = ff & ".xlsx" 'si l'extension n'est pas en majuscule, on la met en minuscule, çà veut dire quoi ?
XlsXfileFrom = P & mfold & sfold & ff
'------------Tester si le fichier existe-------------------------------------------------
If X1cFileExists(XlsXfileFrom) = False Then
MsgBox ("Le fichier n'existe pas : " & vbCrLf & XlsXfileFrom)
ErrorExit = True
Exit Function
End If
'------------Afficher le paramètres d'importation en mode de déverminage---------------------------- 'debugg ?
If Not Debugg = False Then MsgBox ("Import xlsx File From: " & XlsXfileFrom & vbCrLf _
& "SheetFrom: " & wsf & vbCrLf _
& "SheetTo: " & wst & vbCrLf)
'------------Connexion Methode ADO----------------------------------------------
Set Cn = New ADODB.Connection '?
' Utiliser toujours IMEX = 1 est un moyen plus sûr de récupérer des données pour des colonnes de données mélangées.
'çà veut dire quoi IMEX ?
With Cn
.Provider = "Microsoft.Jet.OLEDB.4.0"
.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
& XlsXfileFrom & ";Extended Properties=""Excel 12.0;HDR=YES;IMEX=1;"""
.Open
End With
SQLText = "SELECT * FROM [" & wsf & "$]"
Set Rst = New ADODB.Recordset
Set Rst = Cn.Execute(SQLText) '?
For i = 0 To Rst.Fields.Count - 1 '?
ws.Cells(r, c + i) = Rst.Fields(i).Name '?
Next i
ws.Cells(r + 1, c).CopyFromRecordset Rst '?
Cn.Close '?
'-----Attribuer la collection range du tableau de données à la variable objet rg-----------
Set ws = Worksheets(SheetTo) ' c'est quoi la différence avec Set ws = wb.Worksheets(wst) ?
Set rgt = X1cRangeObject(ws, r, c, True) '?
If IsMissing(CreateTable) = True Then CreateTable = False 'IsMissing(CreateTable)?
If Not CreateTable = False Then '= if createtable = true ?
'------------Renommer le champ de données " SheetTo "-----------------------------------------------
If ws.ListObjects.Count = 0 Then 'Si la table n'existe pas alors creer la table au nom de la feuille
ws.ListObjects.Add(xlSrcRange, rgt, , xlYes).Name = "Tbl_" & SheetTo
ElseIf ws.ListObjects.Count > 1 Then 'Si la table existe ajouter les données à la table et supprimer la ligne de titre de la nouvelle Importation
ws.Rows(r).Delete
End If
Else 'il est ou le code pour l'ajout de données ?
rgt.Name = wst
End If
rgt.Columns.AutoFit
Set rgt = Nothing
Set Rst = Nothing
Set wb = Nothing
Set Cn = Nothing
Set ws = Nothing
End Function |
Importation plage tableau d'un fichier fermé
Répondre avec citation
Envoyé par frunch
et si celle-ci est pertinente pensez à voter 
Partager