XL 2021 Problème d'accès aux datas d'une autre feuille fermée

[p'tit vieux]

Bonjour à tous,
Comme le titre l'indique j'ai un petit souci dans un UDF que j'espère pouvoir vous soumettre bientôt..
Je sais que c'est un sujet assez récurant mais je n'ai rien lu qui résolve mon exemple.
Voici le problème ...
J'ai une fonction dans un fichier (Fonction.xlsm) qui lit des valeurs dans un autre fichier (Datas externes.xlsx).

1. Lorsque celui-ci est ouvert pas de souci.
2. Lorsqu'il est fermé j'ai 2 cas:
   1. Si c'est une plage de cellule => >Je reçois un tableau (ca me gène mais ca se gère)
   2. Si plusieurs Areas (zones) là j'ai une erreur 2015.

Je sais que la principale solution est d'ouvrir (masqué !) le fichier par code VBA j'ouvre des données externes mais, dans ma macro, je n'ai pas réussi à ouvrir le fichier(Datas externes.xlsx) avec ce qui est proposé dans les forums. Pour l'instant, je ne comprend pas pourquoi mais c'est ainsi.
Par contre je vois un défaut au fait d'ouvrir un fichier: Par exemple, imaginé le temps d'ouverture avec un gros fichier complexe avec des calculs dans tous les sens

Donc si quelqu'un à une ou plusieurs idées
Cordialement à tous

 

[patricktoulon]

re
bonjour
a tu dejà entendu parler de ADO
voir même encore plus simple les formule de liaison
et entre parenthèses ces deux méthodes d'exonère l'ouverture physique du fichier
tu a moult exemples sur le forum
il y a un moteur de recherche ,c'est pas fait pour faire joli
je ne parle même pas du fait que si tu scroll la page de ce topic tu trouvera des discussions similaires

 

[p'tit vieux]

Bonjour Patrick
Merci pour l'info. Oui je connais(connaissais) (ADO, ODBC SQL Server etc). Mais je ne l'utilise (utilisais) que pour ACCESS/SQL Server et/ou dans VB.
Je vais regarder si j'ai les résultats que je désire.
Le gros souci et dans l'idéale (Chose à laquelle nul n'est tenu) j'ai besoin des adresses des cellules.
Je ne crois pas que je les aurais avec une requête SQl.
Merci je regarde cela. Je suis presque sûr que tu as du faire un beau tuto là-dessus quelque part
Encore merci
à bientôt.

 

[patricktoulon]

re
non je n'ai pas fait de tuto
mais je peux te conseiller de te raprocher de @dysorthographie pour ADO ou @job75 pour les formules de liaison dynamique par vba
la deuxieme solution etant la plus simple
il y a aussi power query je le cite jamais car je ne l'utilise pas mais si tu a une version récente d'excel ca semble etre une bonne alternative

 

[p'tit vieux]

Re Patrick … et à tous
J'ai essayé avec ADO à partir de l'un de tes codes que j'ai "piraté" .
Ton code est celui ci
Il fonctionne lorsque c'est une plage (A1:A500) mais pas avec plusieurs Areas (A1:A20; A50:A60; A80).
Si tu sais pourquoi.
Je pense que le Recordset ne pourra pas marcher.
Une possible solution serait de décomposer Area par Area.
Pas très cool car il me faudra analyser/décomposer tout le paramètre.
Je continue ma prospection

 

[patricktoulon]

re
ben alors !!???? .....fait 3 requêtes tout simplement

 

[p'tit vieux]

Alors là ... T'es dur avec moi

 

[p'tit vieux]

Bonjour Patrick, et à tous
Suite à tes conseils z'avizzés Bon voila le résultat de mes délires

Option Explicit

' ======
' EN FAIRE UNE CLASSE! Plus cool
' Avec fonction de concatenation "automatique" des tableaux
Type Result_Type
    Value() As Variant
    Address() As String
    LeType() As Variant
End Type

Dim Tablo() As Result_Type
' ======

Sub Test_récup_plage()
    Dim I, J, K
    Dim Fichier$, Item
    Dim MyRge
    Set MyRge = Range("C1:C3,C5:C6")
    ReDim Tablo(1 To MyRge.Areas.Count)
    ReDim T(1 To MyRge.Areas.Count)
    Fichier = "E:\FONCTIONS VBA PERSO\TESTS\Datas externes.xlsx"     'à adapter
'  NOTE! Le passage d'adresses préfixées $Ligne$Colon ne marche pas.
    For Each Item In MyRge.Areas
      I = I + 1
      ReDim Tablo(I).Address(1 To Item.Rows.Count, 1 To Item.Columns.Count)
'    Sauve les adresses
      For J = 1 To Item.Rows.Count
        For K = 1 To Item.Columns.Count
          Tablo(I).Address(J, K) = Item.Cells(J, K).Address(False, False)
        Next K
      Next J
      ReDim Tablo(I).Value(1 To Item.Rows.Count, 1 To Item.Columns.Count)
      ReDim Tablo(I).LeType(1 To Item.Rows.Count, 1 To Item.Columns.Count)
      T(I) = GetUserRangeOnClosedFich2(I, Fichier, Item.Address(False, False), "Feuil1", False)
    Next Item

'    [A1].Resize(UBound(T), UBound(T, 2)) = T

    For I = 1 To UBound(Tablo)
      For J = 1 To UBound(Tablo(I).Value)
        For K = 1 To UBound(Tablo(I).Value, 2)
          Debug.Print "Valeur: ", Tablo(I).Value(J, K)
          Debug.Print "Adresse: ", Tablo(I).Address(J, K)
          Debug.Print "Type: ", Tablo(I).LeType(J, K)
        Next K
      Next J
      Debug.Print "========"
    Next I
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(ByVal Index As Integer, 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
                Tablo(Index).Value(RsTLigne, RsTCol + 1) = RsT.Fields(RsTCol).Value
                Tablo(Index).LeType(RsTLigne, RsTCol + 1) = RsT.Fields(RsTCol).Type
            Next
            RsT.MoveNext
        Next
    Loop
    AdConn.Close
    Set RsT = Nothing
    Set AdoComand = Nothing
    Set AdConn = Nothing
    GetUserRangeOnClosedFich2 = Arr
End Function

 

[p'tit vieux]

Désolé pour le code écrit à la va-vite.
L'objectif étant de savoir si tu as mieux je suis preneur.
Je pense en faire 2 classes l'une pour faire la/les connexions ADO avec le/les recordset
Pour cela j'ai retrouvé le code de ces classes (avec Events) que j'avais écrit il y a … plus de 20 ans. Bon faut adapter.
La 2eme classe en remplacement du Type Result ci-dessus pour récupérer les résultats.
Voilà pour ce Dimanche.

Bonne fin de Week-end.


PS:
Pour le fun, et si cela peut être utile ou donner des idées, je mets les Classes originales (version brute de coffrage => à adapter).
L'avantage est que l'on peut avoir une collection de connexions et/ou n'utiliser qu'une seule pour plusieurs requêtes. Exemple: Si on pointe sur plusieurs bases et/ou fichiers
Pour utiliser/lire juste retirer les extensions txt.

 

[patricktoulon]

a ben c'est mon code ADO ça ?
ben oui tu le fait autant de fois que d'adrea c'est exactement
ta partie tableau je suis casiment sur que tu peux la simplifier
sachant que ma fonction GetUserRangeOnClosedFich2 se suffit en elle même et comme elle te renvoie un tableau
la sub d'appel ne devrait pas faire plus de 10 lignes
mais c'est bien t'a compris le truc

 

[job75]

Bonsoir p'tit vieux, Patrick,

Juste en passant, sur le fichier Fonction.xlsm du post #1 :

- utiliser la fonction Excel SOMME au lieu de la fonction Total qui est un mauvais bricolage

- au lieu de Feuil1!$C$1:Feuil1!$C$2 utiliser Feuil1!$C$1:$C$2

A+

 

[p'tit vieux]

Re Patrick, bonjour Job75
Oui Patrick c'est ton ADO. Bon remanié certes.

Oui Job75. il y a la fonction Excel Somme. Je te sens moqueur là.
Il fallait que je trouve un exemple … à ma portée.

Plus sérieusement, juste pour comprendre.
Lorsque l'on passe l'adresse au format C1 ... ca marche. Mais si c'est $C$1 ca marche plus.
Je n'ai pas trouvé l'erreur de syntaxe ni le pourquoi.
Une explication?

 

[job75]

Pour ce que vous voulez faire, la solution la plus simple est d'utiliser des formules de liaison.

Téléchargez les fichiers joints dans le même dossier (le bureau).

Ouvrez le fichier .xlsm et voyez cette macro :

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [E2]) Is Nothing Then Exit Sub
Dim chemin$, fichier$, feuille$, form$, a As Range, f$
If TypeName(Evaluate([E2].Text)) <> "Range" Then [E2] = "C1"
chemin = ThisWorkbook.Path & "\"
fichier = "Datas externes.xlsx"
feuille = "Feuil1"
form = "'" & chemin & "[" & fichier & "]" & feuille & "'!"
For Each a In Range([E2]).Areas
    f = f & "," & form & a.Address 'concatène les formules
Next
[E4] = "=SUM(" & Mid(f, 2) & ")" 'cellule Résultat
End Sub

Elle se déclenche quand on modifie ou valide la cellule E2.

A+

 

[dysorthographie]

Bonjour,

'Option Explicit

Function Total(Cellule As Range) As Variant
  Total = WorksheetFunction.Sum(Cellule)
End Function

Sub test_récup_plage()
    Dim fichier$, T
    fichier = ThisWorkbook.Path & "\Datas externes.xlsx"    'à adapter
    T = GetUserRangeOnClosedFich2(fichier, "C1;C3", "Feuil1", False)
    [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 String, RsT As Object ', AdoComand As Object
'    Set AdConn = CreateObject("ADODB.Connection")
'    Set AdoComand = CreateObject("ADODB.Command")
    Set RsT = CreateObject("ADODB.Recordset")

    HDR = Array("No", "Yes")(Abs(headerTable))

   AdConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & fichier & ";Extended Properties=""Excel 12.0;HDR=No;IMEX=1;"""
   Dim SQL As String
    If Feuille = "" Then
        SQL = "SELECT * from `" & RnG & "`"
       Else
     
            For Each g In Split(RnG & ";", ";")
                If g <> "" Then
                    If SQL <> "" Then SQL = SQL & " Union All"
                     SQL = SQL & " SELECT * from [" & Feuille & "$" & g & ":" & g & "]"
                End If
               
       
         Next
       End If
     RsT.Open SQL, AdConn, 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
Rst.close : Set RsT = Nothing ': Set 'AdoComand = Nothing: Set AdConn = Nothing
    GetUserRangeOnClosedFich2 = Arr
End Function

 

[job75]

Bonjour le forum,

Une variante avec l'utilisation de Union pour que C1,C2 soit traité comme C1:C2 :

For Each a In Union(Range([E2]), Range([E2])).Areas

A+