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 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150
|
Private Sub ConnectCLasseur(ConnectCL As Object, _
Fichier As String, _
Optional Rs)
Set ConnectCL = CreateObject("ADODB.Connection")
If Not IsMissing(Rs) Then
Set Rs = CreateObject("ADODB.Recordset")
End If
ConnectCL.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Fichier & ";" & _
"Extended Properties=""Excel 8.0;HDR=NO;IMEX= 2;"""
End Sub
Sub RecupValeurs()
Dim ConnectCL As Object
Dim Rs As Object
Dim Champ As Object
Dim Tableau()
Dim TblFichiers() As String
Dim Classeur As String
Dim NomFeuille As String
Dim Dossier As String
Dim Plage As String
Dim DerCel As Integer
Dim Test As Integer
Dim I As Integer
Dim J As Integer
Dim K As Integer
Dossier = "D:\Dossier Excel\"
'chemin du classeur cible
TblFichiers() = Classeurs(Dossier)
On Error Resume Next
Test = UBound(TblFichiers)
If Err.Number <> 0 Then
MsgBox "Aucun fichier Excel dans le dossier !"
Err.Clear
Exit Sub
End If
For K = 1 To Test
Classeur = Dossier & TblFichiers(K)
'nom de la feuille où se trouve la plage
'adapter le nom mais la feuille de récup doit être nommée pareil que les autres !)
NomFeuille = "Feuil1"
'défini la plage sur la colonne A pour la recherche du nombre
'de cellules non vides
Plage = "A1:A65536" 'adapter l'adresse
'ouvre une première connecxion pour la recherche
ConnectCLasseur ConnectCL, Classeur, Rs
'défini la dernière ligne non vide de la colonne A
Set Rs = ConnectCL.Execute("SELECT COUNT(*) FROM `" & NomFeuille & "$" & Plage & "` ")
DerCel = Rs.Fields(0).Value
'plage à récupérer, doit être définie comme "Xx:Xx"
Plage = "A1:D" & DerCel
'ferme le Recordset
Rs.Close
'puis le réouvre pour inscrire la valeur
With Rs
.CursorType = 1
.LockType = 3
.Open "SELECT * FROM `" & NomFeuille & "$" & Plage & "` ", ConnectCL
.MoveFirst
ReDim Tableau( _
1 To .RecordCount, _
1 To .Fields.Count)
Do While Not .EOF
I = I + 1
For Each Champ In .Fields
J = J + 1
Tableau(I, J) = Champ.Value
Next
J = 0
.MoveNext
Loop
I = 0
End With
ConnectCL.Close
'Stop
'inscrit dans "NomFeuille" du classeur actif et la vide
With ThisWorkbook.Worksheets(NomFeuille)
DerCel = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
.Range(.Range("A" & DerCel), .Cells(UBound(Tableau, 1) + DerCel - 1, UBound(Tableau, 2))).Value = Tableau
End With
Erase Tableau
Next K
Set Rs = Nothing
Set ConnectCL = Nothing
End Sub
Function Classeurs(Chemin As String) As String()
Dim Tbl() As String
Dim Fichier As String
Dim I As Integer
Fichier = Dir(Chemin)
Do While (Len(Fichier) > 0)
'seuls les fichiers Excel
If InStr(Fichier, ".xls") <> 0 Then
I = I + 1
ReDim Preserve Tbl(1 To I)
Tbl(I) = Fichier
End If
Fichier = Dir()
Loop
Classeurs = Tbl()
End Function |
Partager