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

p'tit vieux · 16 Décembre 2023

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).

Lorsque celui-ci est ouvert pas de souci.
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

p'tit vieux · 18 Décembre 2023

job75 à dit:
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 :

VB:

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+

Bonjour Job75
Je viens de tester le code.
Cela marche super! Le truc est que pour mon besoin ça n'a pas l'air d'être ça.
J'ai du mal m'exprimer ou pas assez précis dans ma question.
Pour exemple, j'ai créé une fonction simple (simpliste) Total() pour simuler une lecture de valeurs appelée par une fonction (qui n'a rien à voir avec des fonctions Excel).
Là je suis un peu juste niveau temps. Mais je vais approfondir ton idée.
Merci

p'tit vieux · 18 Décembre 2023

dysorthographie à dit:

Bonjour,

VB:

'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

Merci Dys pour ton code.
Comme je l'ai dis à Job75, je suis pris là donc je n'ai pas encore eu le temps de bien regarder.
Je vois cela un peu plus tard et dés mon retour je te donne le résultat des courses.

job75 · 18 Décembre 2023

p'tit vieux à dit:
Pour exemple, j'ai créé une fonction simple (simpliste) Total() pour simuler une lecture de valeurs appelée par une fonction (qui n'a rien à voir avec des fonctions Excel).

Si vous tenez absolument à votre fonction Total il faut la construire autrement :

VB:

Function Total(ParamArray tablo()) As Double
Dim e As Variant
For Each e In tablo
    Total = Total + Application.Sum(e)
Next
End Function

p'tit vieux · 18 Décembre 2023

dysorthographie à dit:

Bonjour,

VB:

'Option Explicit
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

(re) Bonjour à tous
Re Dys
Bonne idée le UNION ALL.
Ca marche nickel avec la plage exemple Plages ="C1;C3"
SQL$= "SELECT * from [Feuil1$C1:C1] Union All SELECT * from [Feuil1$C3:C3]"
J'aime bien ton code Split etc.
je viens de tester mais avec d'autres plages et là y a un/des problèmes de syntaxes de la requête SQL.
1) Le cas qui ne marche pas du tout c'est avec des adresses absolues $C$4:$C$7 ...
2) Autre cas avec : Plages = "C4:C7;C11:C15;C21:C25;C42"
Cela donne:
SQL$ = "SELECT * from [Feuil1$C4:C7] Union All SELECT * from [Feuil1$C11:C15] Union All SELECT * from [Feuil1$C21:C25] Union All SELECT * from [Feuil1$C42] Union All SELECT * from [Feuil1$C4:C7:C4:C7] Union All SELECT * from [Feuil1$C11:C15:C11:C15] Union All SELECT * from [Feuil1$C21:C25:C21:C25] Union All SELECT * from [Feuil1$C42:C42]"

J'ai tenté et tente encore de voir où est le problème syntaxique
encore merci

Cousinhub · 18 Décembre 2023

Bonsoir,
Patrick t'avait mis sur une piste..

patricktoulon à dit:
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

Qu'en penses-tu?
Bonne soirée

p'tit vieux · 18 Décembre 2023

Cousinhub à dit:
Bonsoir,
Patrick t'avait mis sur une piste..

Qu'en penses-tu?
Bonne soirée

Bonsoir Cousin
Oui c'est possible … en temps normal.
Sauf que là je cherche une solution pour l'utiliser à l'intérieur d'un UDF (User Define Function) donc techniquement je ne connais pas les utilisateurs futurs (éventuels ).
Ma première idée a été de simplement ouvrir le fichier sans l'afficher.
Je crois avoir essayé tout ce que j'ai trouvé sur les forums. (WorkBooks.add etc. etc.)
Mais rien à faire le fichier ne s'ouvre. Excel m'en veut ... SNIFF (Calimero )
Mais patience … Je l'aurai, je l'aurai … un jour.
Merci

Cousinhub · 18 Décembre 2023

Re-,
Pas de soucis, c'est pour toi (et ton futur entourage...)
Cependant, comme ce "futur" est de plus en plus frileux quant au langage VBA (de plus en plus d'entreprises le bannissent), une simple configuration unique à prévoir, et tout est fait.... (en gros, un "lisez-moi.txt" pour configurer l'application Excel)
Pour moi, une appli utilisant des macros avancées (et j'en ai fait quelques-une...) ne fonctionne correctement que le temps de présence du "géniteur"...(ou d'un soutenant sachant chasser sans ses chiens (non, là, je dérive...)
Bon courage dans tes recherches

p'tit vieux · 18 Décembre 2023

Cousinhub à dit:
Re-,
Pas de soucis, c'est pour toi (et ton futur entourage...)
Cependant, comme ce "futur" est de plus en plus frileux quant au langage VBA (de plus en plus d'entreprises le bannissent), une simple configuration unique à prévoir, et tout est fait.... (en gros, un "lisez-moi.txt" pour configurer l'application Excel)
Pour moi, une appli utilisant des macros avancées (et j'en ai fait quelques-une...) ne fonctionne correctement que le temps de présence du "géniteur"...(ou d'un soutenant sachant chasser sans ses chiens (non, là, je dérive...)
Bon courage dans tes recherches

Merci pour ton conseil sur mon futur. C'est sympa.
Cela étant je te renvoie à mon pseudo

De plus, cela fait plus de 20 ans que VB et VBA doivent disparaitre. Ce sujet est récurant.
Je fais cela pour le plaisir. Parfois pour l'argent aussi (Soyons honnête )
Juste 2 réflexions:
1) Il y a des milliards de lignes de code en VB (Dévlpt. d'application en tout genre) et VBA (Excel, Access, AutoCad, Catia et autres divers logiciels incluant ce langage etc.). Donc les entreprises ont besoin de personnes connaissant très bien VB à minima pour porter leurs applications vers du .Net.
2) Tu as raison. Connaitre VB (VBA) ne suffit pas. De même que savoir coder en Assembleur n'est pas très professionnellement porteur.

Donc ton conseil est plein de bon sens. Parole de P'tit Vieux
Bonne soirée et bon Noël
PS:
Pour te donner une idée de mon âge … Comme d'autres ici je suppose j'ai commencé sur Amstrad

Cousinhub · 18 Décembre 2023

Hi,
T'inquiète, moi aussi, je suis en retraite....
Et avant, je n'entendais que par le VBA...
Puis, j'ai commencé à explorer d'autres pistes (par curiosité intellectuelle, envie de connaître, ....)
Maintenant, je ne renie surtout pas ce que j'ai fait (et produit), mais je regarde un peu plus les alternatives (du futur???? )
Bonne soirée

dysorthographie · 18 Décembre 2023

Bonsoir,
tu ne fais pas ce que tu veux tu n'es plus dans EXCEL du est dans une base de données ODBC

la syntaxe est [Feuil1$C3:C3] tu ne peux pas déroger!

VB:

RnG = "$C$11:$C$15;$C20:$C$21;$C$18"
For Each g In Split(Replace(RnG, "$", "") & ";", ";")
                If g <> "" Then
                    If SQL <> "" Then SQL = SQL & " Union All"
                     SQL = SQL & " SELECT * from [" & Feuille & "$" & g & IIf(InStr(1, g, ":") = 0, ":" & g, "") & "]"
                End If                  
         Next

VB:

Sub test_récup_plage()
    Dim fichier$, T
    fichier = ThisWorkbook.Path & "\Datas externes.xlsx"    'à adapter
    T = GetUserRangeOnClosedFich2(fichier, "$C$11:$C$15;$C20:$C$21;$C$18", "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
     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(Replace(RnG, "$", "") & ";", ";")
                If g <> "" Then
                    If SQL <> "" Then SQL = SQL & " Union All"
                     SQL = SQL & " SELECT * from [" & Feuille & "$" & g & IIf(InStr(1, g, ":") = 0, ":" & g, "") & "]"
                End If
            Next
       End If
       Dim Rs As Object: Set Rs = CreateObject("ADODB.Recordset")   
         Rs.Open SQL, AdConn, 1, 1
            If Not Rs.EOF Then Arr = Application.Transpose(Rs.GetRows) Else Arr = Array("", "")
            Rs.Close: Set Rs = Nothing
    GetUserRangeOnClosedFich2 = Arr
End Function

p'tit vieux · 18 Décembre 2023

dysorthographie à dit:

Bonsoir,
tu ne fais pas ce que tu veux tu n'es plus dans EXCEL du est dans une base de données ODBC

la syntaxe est [Feuil1$C3:C3] tu ne peux pas déroger!

VB:

RnG = "$C$11:$C$15;$C20:$C$21;$C$18"
For Each g In Split(Replace(RnG, "$", "") & ";", ";")
                If g <> "" Then
                    If SQL <> "" Then SQL = SQL & " Union All"
                     SQL = SQL & " SELECT * from [" & Feuille & "$" & g & IIf(InStr(1, g, ":") = 0, ":" & g, "") & "]"
                End If                 
         Next

VB:

Sub test_récup_plage()
    Dim fichier$, T
    fichier = ThisWorkbook.Path & "\Datas externes.xlsx"    'à adapter
    T = GetUserRangeOnClosedFich2(fichier, "$C$11:$C$15;$C20:$C$21;$C$18", "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
     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(Replace(RnG, "$", "") & ";", ";")
                If g <> "" Then
                    If SQL <> "" Then SQL = SQL & " Union All"
                     SQL = SQL & " SELECT * from [" & Feuille & "$" & g & IIf(InStr(1, g, ":") = 0, ":" & g, "") & "]"
                End If
            Next
       End If
       Dim Rs As Object: Set Rs = CreateObject("ADODB.Recordset")  
         Rs.Open SQL, AdConn, 1, 1
            If Not Rs.EOF Then Arr = Application.Transpose(Rs.GetRows) Else Arr = Array("", "")
            Rs.Close: Set Rs = Nothing
    GetUserRangeOnClosedFich2 = Arr
End Function

Merci @dysorthographie
Donc il faut que toute requête respecte exactement les mêmes syntaxes et règles que pour Access ou SQL Serveur . C'est ça ?
Y compris pour les.Updates Insert etc.
Pour mon usage, pas simple quand-même la mise en œuvre.
J'espère que les performances sont bonnes.
Là je suis sur mon phone.
Demain je teste cela.
Bonne nuit.

dysorthographie · 18 Décembre 2023

Oui tu es dans une base de données qui respecte le langage SQL. Notes que le delete pour le coup n'existe pas pour Excel.

job75 · 18 Décembre 2023

Ma solution post #18 passe à la trappe ? C'est pourtant bien plus simple.

dysorthographie · 18 Décembre 2023

job75 à dit:
Ma solution post #18 passe à la trappe ? C'est pourtant bien plus simple.

Tu sais moi je passerai par là j'ai vu de la lumière

p'tit vieux · 19 Décembre 2023

job75 à dit:
Ma solution post #18 passe à la trappe ? C'est pourtant bien plus simple.

Bonjour à tous.
Mais non !
Mais je n'avais pas vu les nouveaux fichiers que tu avais mis.
Je suis coincé toute la matinée mais je regarde cette après midi.

Merci pour ton aide.

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

p'tit vieux

XLDnaute Occasionnel

Pièces jointes

p'tit vieux

XLDnaute Occasionnel

p'tit vieux

XLDnaute Occasionnel

job75

XLDnaute Barbatruc

Pièces jointes

p'tit vieux

XLDnaute Occasionnel

Cousinhub

XLDnaute Barbatruc

p'tit vieux

XLDnaute Occasionnel

Cousinhub

XLDnaute Barbatruc

p'tit vieux

XLDnaute Occasionnel

Cousinhub

XLDnaute Barbatruc

dysorthographie

XLDnaute Accro

p'tit vieux

XLDnaute Occasionnel

dysorthographie

XLDnaute Accro

job75

XLDnaute Barbatruc

dysorthographie

XLDnaute Accro

p'tit vieux

XLDnaute Occasionnel

Discussions similaires