Microsoft 365 Remplir une combobox à partir d'un autre fichier

Option Explicit

Public Const NDF = "B:\Commun\Suivi des temps\Test\Parametrage.xlsx"


Private RcdSt() As Variant
Private Req As String


' *************************************************************************************************
Function Query(Req As String) As Long
Dim Cnx As Object, Rst As Object
Dim i As Long, j As Long

    On Error GoTo errhdlr

    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
        If Not Query = 0 Then
            ReDim RcdSt(Rst.Fields.Count - 1, Query - 1)
            Rst.MoveFirst
            RcdSt = Rst.GetRows
            For i = 0 To UBound(RcdSt, 1) - 1
                For j = 0 To UBound(RcdSt, 2) - 1
                    If IsNull(RcdSt(i, j)) Then RcdSt(i, j) = ""
                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
    MsgBox (err.description)
End Function


Function Get_Combo(Chps As String, Ong As String, Optional Cnd As String) As Variant()

    Req = "SELECT DISTINCT " & Chps & " FROM [" & Ong & "$]"

    If Not Cnd = "" Then Req = Req & " WHERE " & Cnd

    Req = Req & " ORDER BY " & Chps

    Erase Get_Combo
    If Query(Req) > 0 Then Get_Combo = Application.Transpose(RcdSt)

End Function