Sub test_récup_plage()
Dim fichier$, Tbl
fichier = ThisWorkbook.Path & "\BASE.xlsx" 'à adapter
Tbl = GetcolumnValueOnClosedWbookskeepblank(fichier, "A1:A20", "Feuil1", False)
'With ActiveSheet.ComboBox1: .Clear: .List = Tbl: End With
Sheets("Feuil2").[A1].Resize(UBound(Tbl), 1) = Tbl
End Sub
Function GetcolumnValueOnClosedWbookskeepblank(fichier As String, RnG As String, Feuille As String, Optional headerTable As Boolean = False)
Dim AdConn As Object, AdoComand As Object, HDR$, RsT As Object, RsTLigne&, RsTCol&, v$, Arr()
Set AdConn = CreateObject("ADODB.Connection")
Set AdoComand = CreateObject("ADODB.Command")
Set RsT = CreateObject("ADODB.RecordSet")
HDR = Array("No", "Yes")(Abs(headerTable))
AdConn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & fichier & ";Extended Properties=""Excel 12.0;HDR=NO;IMEX=1"""
AdoComand.ActiveConnection = AdConn
AdoComand.CommandText = "SELECT * from `" & Feuille & "$" & RnG & "`"
RsT.Open AdoComand, , 1 ', 3
RsT.MoveFirst
Do While Not RsT.EOF
For RsTLigne = 1 To RsT.RecordCount 'lignes
If Not IsNull(RsT.Fields(0).Value) Then a = a + 1: ReDim Preserve Arr(1 To a): Arr(a) = RsT.Fields(0).Value
If Not Arr(a) Like "*[A-z,:,€]*" Then
If IsDate(Arr(a)) Then Arr(a) = Format(CDate(Arr(a)), "m/d/yyyy")
Else
Arr(a) = "'" & Replace(Arr(a), ",", ".")
End If
RsT.MoveNext
Next
Loop
MsgBox "je fout le boxon j'inverses le format de date" & vbCrLf & Join(Arr, vbCrLf)
AdConn.Close: Set RsT = Nothing: Set AdoComand = Nothing: Set AdConn = Nothing
GetcolumnValueOnClosedWbookskeepblank = Application.Transpose(Arr)
End Function
mais plutôt comme un sauf conduit
