Microsoft 365 importer une plage d'un fichier fermé

Sub LireFichierFermé()
    Dim Fichiersource$, Cheminsource$, Formule$
    Application.ScreenUpdating = False
    [A1:K26].ClearContents
    Cheminsource = ThisWorkbook.Path & "\"
    Fichiersource = "JournalAux-97.xlsx"
    Formule = "='" & Cheminsource & "[" & Fichiersource & "]JournalReport'!$A$1:$K$26"
    With Range("$A$1:$K$26")
        .Value = Formule
        .Value = .Value
    End With
    [A1:K26].Replace What:="0", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
End Sub

Sub LitClasseurFermé()
    Dim Rsource As Range, Rdest As Range, Chemin$, Fichier$, Onglet$
    Chemin = ThisWorkbook.Path    'chemin du fichier source
    Fichier = "JournalAux-97.xlsx"    'nom du fichier source
    Onglet = "JournalReport"    'feuille du fichier source
    Set Rsource = [A1:k26]    ' plage du fichier source
    Set Rdest = ShDatas.[A1].Resize(Rsource.Rows.Count, Rsource.Columns.Count)    'destination
    LitChamp Rdest, Chemin, Fichier, Onglet, Rsource    'lance l'execution
    ShDatas.Range("A1:K5").Replace What:="0", Replacement:="", LookAt:=xlWhole
End Sub

Sub LitChamp(Rdest As Range, Chemin, Fichier, Onglet, Rsource As Range)
    Rdest.FormulaArray = "='" & Chemin & "\[" & Fichier & "]" & Onglet & "'!" & CStr(Rsource.Address(0, 0))    'formule matricielle de liaison
    Rdest = Rdest.Value    'supression des formulesremplacement des formules par les valeurs
End Sub

ShDatas.Range("A1:K5").Replace What:="0", Replacement:="", LookAt:=xlWhole

Rdest = Rdest.Value

    Rdest.FormulaArray = "=""""&'" & Chemin & "\[" & Fichier & "]" & Onglet & "'!" & CStr(Rsource.Address(0, 0))    'formule matricielle de liaison

Sub GetUserRangeOnClosedFich(fichier$, feuille$, destination As Range)
   'patricktoulon
   'version 2021
   Dim Ado As Object, texte_SQL$, AdoReQ As Object
      Set Ado = CreateObject("ADODB.Connection")    'instance d'ado
    With Ado    'Ado Connexion
       ' .Provider = "Microsoft.Jet.OLEDB.4.0"
        .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & fichier & ";Extended Properties=""Excel 12.0;HDR=YES;"""
        .Open
    End With
    texte_SQL = "select * from [" & feuille & "$]" 'adapter le non de la feuill si besoins
    Set AdoReQ = CreateObject("ADODB.Recordset")
    Set AdoReQ = Ado.Execute(texte_SQL)

    'inscrisption du return de AdoReQ a la suite dans le sheets
   destination.CopyFromRecordset AdoReQ
    '--- Fermeture connexion ---
    Ado.Close
    Set Ado = Nothing
End Sub

Sub lance()
Dim fichier$, feuille$, destination As Range
fichier = "C:\Users\patrick1\Desktop\Telechar\JournalAux-97.xlsx"    'chemin du  classeur fermé servant de base de données
feuille = "JournalReport"
Set destination = ShDatas.Cells(1)
GetUserRangeOnClosedFich fichier, feuille, destination
End Sub

Sub test_récup_plage()
    Dim fichier$, T
    fichier = "C:\Users\patrick1\Desktop\Telechar\JournalAux-97.xlsx"     'à adapter
    T = GetUserRangeOnClosedFich2(fichier, "A1:k26", "JournalReport", False)
    ShDatas.[A1].Resize(UBound(T), UBound(T, 2)) = T
End Sub

'renvoie les valeurs d'une plage de cellules contigües (RnG)
'd'une feuille (Feuille) d'un fichier (fichier) fermé
'le paramètre headerTable indique si la plage a ou non une ligne d'entêtes
Function GetUserRangeOnClosedFich2(fichier As String, RnG As String, Optional Feuille As String = "", Optional headerTable As Boolean = False)
    Dim HDR As String, RsTLigne As Integer, RsTCol As Integer
    'early binding
    'Dim AdConn As ADODB.Connection, AdoComand As ADODB.Command, RsT As ADODB.Recordset
    'Set AdConn = New ADODB.Connection
    'Set RsT = New ADODB.Recordset
    'Set AdoComand = New ADODB.Command

    'late binding
    Dim AdConn As Object, AdoComand As Object, RsT As Object
    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
    If Feuille = "" _
       Then AdoComand.CommandText = "SELECT * from `" & RnG & "`" _
       Else AdoComand.CommandText = "SELECT * from `" & Feuille & "$" & RnG & "`"
    RsT.Open AdoComand, , 1, 1
    ReDim Arr(1 To RsT.RecordCount, 1 To RsT.Fields.Count)
    RsT.MoveFirst
    Do While Not RsT.EOF
        For RsTLigne = 1 To RsT.RecordCount  'lignes
            For RsTCol = 0 To RsT.Fields.Count - 1  'colonnes
                Arr(RsTLigne, RsTCol + 1) = RsT.Fields(RsTCol).Value
            Next
            RsT.MoveNext
        Next
    Loop
    AdConn.Close: Set RsT = Nothing: Set AdoComand = Nothing: Set AdConn = Nothing
    GetUserRangeOnClosedFich2 = Arr
End Function

Sub test_récup_plage()
    Dim Fichier$, T
    Fichier = "C:\Users\patrick1\Desktop\Telechar\JournalAux-97.xlsx"     'à adapter
    T = GetUserRangeOnClosedFich2(Fichier, "A1:k100000", "JournalReport", False)
    Application.ScreenUpdating = False
    ShDatas.[A1].Resize(UBound(T), UBound(T, 2)) = T
End Sub

'renvoie les valeurs d'une plage de cellules contigües (RnG)
'd'une feuille (Feuille) d'un fichier (fichier) fermé
'le paramètre headerTable indique si la plage a ou non une ligne d'entêtes
Function GetUserRangeOnClosedFich2(Fichier As String, Rng As String, Optional Feuille As String = "", Optional headerTable As Boolean = False)
    Dim HDR As String, RsTLigne As Integer, RsTCol As Integer
    'early binding
    'Dim AdConn As ADODB.Connection, AdoComand As ADODB.Command, RsT As ADODB.Recordset
    'Set AdConn = New ADODB.Connection
    'Set RsT = New ADODB.Recordset
    'Set AdoComand = New ADODB.Command

    'late binding
    Dim AdConn As Object, AdoComand As Object, Rst As Object
    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
    If Feuille = "" _
       Then AdoComand.CommandText = "SELECT * from `" & Rng & "`" _
       Else AdoComand.CommandText = "SELECT * from `" & Feuille & "$" & Rng & "`"
    Rst.Open AdoComand, , 1, 1
    ReDim Arr(1 To Rst.RecordCount, 1 To Rst.Fields.Count)
    Rst.MoveFirst
    Do While Not Rst.EOF
        For RsTLigne = 1 To Rst.RecordCount  'lignes
            For RsTCol = 0 To Rst.Fields.Count - 1  'colonnes
                Arr(RsTLigne, RsTCol + 1) = Rst.Fields(RsTCol).Value
            Next
            Rst.MoveNext
        Next
    Loop
    AdConn.Close: Set Rst = Nothing: Set AdoComand = Nothing: Set AdConn = Nothing
    GetUserRangeOnClosedFich2 = Arr
End Function