Me revoici, j'ai eu le temps de me pencher un peu dessus entre midi et 13h.
Du coup le code fonctionne parfaitement, je dois maintenant l'adapter à mon tableur, je souhaite donc avoir votre avis quant aux modifications que j'y apporte, ces dernières sont en rouge dans le texte (j'ai découvert comment ouvrir les macros il y a 10min donc soyez indulgents s'il vous plait
).
Votre avis m'est encore une fois très utile car il m'évitera de perdre un temps précieux, si je commence a tout taper et que cela ne fonctionne pas je risque de lâcher une larme. D'ailleurs est-il est possible d'automatiser l'écriture de la zone que doit prendre en compte ce macro ?
------------------------------------------------------------------
Option Explicit
Private Rcd() As Variant
Private Req As String
Private Tvide(0, 0) As Variant
Sub test()
Dim T As Variant
T = Get_List("Feuil1")
With Sheets("Feuil2")
.UsedRange.ClearContents
.Range("A1").Resize(UBound(T, 1), UBound(T, 2)) = T
.Select
End With
End Sub
' ***** LISTES ************************************************************************************
Function Get_List(Tbl As String) As Variant()
Tvide(0, 0) = ""
Req = "SELECT taxon, sum(A24) as A24_, sum(A25) as A25_, " & _
" sum(A26) as A26_, sum(AA08) as AA08_, " & _
" sum(AA09) as AA09_, sum(AA10) as AA10_, " & _
" sum(AA11) as AA11_, sum(AA12) as AA12_, " & _
" sum(AA13) as AA13_, sum(AA14) as AA14_, " & _
" sum(AA16) as AA16_, sum(AA17) as AA17_" & _
> ........................ la même chose jusqu'à
> " sum(XYZ700000) as XYZ700000_, sum(XYZ700001) as XYZ700001_" & _
" FROM [" & Tbl & "$] GROUP BY taxon"
If Query > 0 Then Get_List = Rcd Else Get_List = Tvide
End Function
Function Query(Optional Ndf As String = vbNullString) As Long
Dim Cnx As Object, Rst As Object, T As Variant
Dim Col As Integer, i As Long, j As Long
On Error GoTo errhdlr
If Ndf = vbNullString Then Ndf = ActiveWorkbook.Path & "\" & ActiveWorkbook.Name
Set Cnx = CreateObject("ADODB.Connection")
Cnx.Provider = "MSDASQL"
Cnx.Open "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};" & _
"DBQ=" & Ndf & "; ReadOnly=False;"
If Left(Req, 6) = "SELECT" Then
Set Rst = CreateObject("ADODB.Recordset")
Rst.Open Req, Cnx, 3
Query = Rst.RecordCount
Col = Rst.Fields.Count
ReDim Rcd(Query + 1, Col)
For j = 0 To Col - 1
Rcd(0, j) = Rst.Fields(j).Name
Next j
If Not Query = 0 Then
Rst.MoveFirst
T = Rst.GetRows
For i = 0 To Query - 1
For j = 0 To Col - 1
Rcd(i + 1, j) = IIf(IsNull(T(j, i)), vbNullString, T(j, i))
Next j
Next i
End If
Else
Cnx.Execute Req
Query = 0
End If
Cnx.Close
Set Rst = Nothing
Set Cnx = Nothing
Exit Function
errhdlr:
If Not Rst Is Nothing Then If Rst.State = 1 Then Rst.Close
If Not Cnx Is Nothing Then If Cnx.State = 1 Then Cnx.Close
Set Rst = Nothing
Set Cnx = Nothing
Query = -1
Debug.Print Err.Description
End Function