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

p'tit vieux

p'tit vieux

XLDnaute Occasionnel
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. :eek::mad:
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
 

Pièces jointes

  • Fonction.xlsm
    21.4 KB · Affichages: 8
  • Datas externes.xlsx
    17.3 KB · Affichages: 10
Trier par date Trier par votes
p'tit vieux

p'tit vieux

XLDnaute Occasionnel
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+
Cliquez pour agrandir...
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
 
Vote positif 0 Vote négatif
p'tit vieux

p'tit vieux

XLDnaute Occasionnel
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
Cliquez pour agrandir...
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.
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
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).
Cliquez pour agrandir...
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
 

Pièces jointes

  • Total Liaisons.xlsm
    26.6 KB · Affichages: 0
  • Datas externes.xlsx
    10.2 KB · Affichages: 0
Vote positif 0 Vote négatif
p'tit vieux

p'tit vieux

XLDnaute Occasionnel
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
Cliquez pour agrandir...
(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]"
1702922488091.png


J'ai tenté et tente encore de voir où est le problème syntaxique
encore merci
 
Vote positif 0 Vote négatif
p'tit vieux

p'tit vieux

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


Qu'en penses-tu?
Bonne soirée
Cliquez pour agrandir...
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
 
Vote positif 0 Vote négatif
Cousinhub

Cousinhub

XLDnaute Barbatruc
Inactif
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
 
Vote positif 0 Vote négatif
p'tit vieux

p'tit vieux

XLDnaute Occasionnel
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
Cliquez pour agrandir...
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
 
Dernière édition:
Vote positif 0 Vote négatif
Cousinhub

Cousinhub

XLDnaute Barbatruc
Inactif
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
 
Vote positif 0 Vote négatif
dysorthographie

dysorthographie

XLDnaute Accro
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
 
Dernière édition:
Vote positif 0 Vote négatif
p'tit vieux

p'tit vieux

XLDnaute Occasionnel
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
Cliquez pour agrandir...
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.
 
Vote positif 0 Vote négatif

Discussions similaires

H
  • Résolu(e)
XL 2016 Copier cellule dans un autre onglets
2
Réponses
16
Affichages
323
Phil69970
Phil69970
M
  • Question
XL 2019 Transposer des données d'une feuille vers une autre sous forme de synthèse
Réponses
8
Affichages
262
mromain
mromain
G
  • Résolu(e)
Microsoft 365 Consolidation données depuis des feuilles
Réponses
2
Affichages
260
gpion
G
V
  • Question
XL 2021 avoir des données dans plusieurs onglets en fonction de plusieurs conditions
Réponses
5
Affichages
524
mapomme
mapomme
L
  • Question
XL 2016 Actualisation d'une query via VBA
Réponses
5
Affichages
435
job75
job75
S
  • Résolu(e)
XL 2016 copier des données d'une feuille à une autre selon critères et protection de la feuille 1
Réponses
6
Affichages
419
steph_29120
S
A
  • Résolu(e)
Microsoft 365 Alimenter automatiquement un tableau à partir des données d'un autre tableau en fonction d'un critère
Réponses
9
Affichages
973
Alexandrax971
A
L
  • Question
Microsoft 365 Trier des données d'une colonne dans une autre
Réponses
2
Affichages
278
Langrand
L
N
  • Résolu(e)
Microsoft 365 Copie de données d'une feuille à une autre
Réponses
4
Affichages
444
Cousinhub
Cousinhub
P
  • Question
Microsoft 365 Problème d'affichage étiquettes Graphique
Réponses
8
Affichages
205
Piment
P

Membres actuellement en ligne

16 membres et 101 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
315 091
Messages
2 116 114
Membres
112 663
dernier inscrit
Pauline243