XL 2019 importer le contenu d'une cellule sans ouvrir le fichier source VBA

Créer une discussion
Répondre

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
P

PascalPax

XLDnaute Nouveau
bonjour a tous,
Je ne suis pas du tout expert en VBA, J'applique les codes utiles souvent récupérés et adaptés .
Aujourd'hui je butte sur la recup d'un contenu de cellule dans un classeur fermé en VBA (code joint).
Le code ne provoque pas d'erreur jusqu'à la msgbox.
Votre connaissance éclairera mon ignorance.
Merci
 

Pièces jointes

Trier par date Trier par votes
Re,

Sinon, un lien vers votre cellule est suffisant ou alors votre macro modifiée:
Code: 
 Sub extractionValeurCelluleClasseurFerme()


    Dim Source As ADODB.Connection

    Dim ADOCommand As ADODB.Command
    Dim Rst As ADODB.Recordset
    Dim Fichier As String, Cellule As String, Feuille As String

    'Adresse de la cellule contenant la donnée à récupérer
    Cellule = "A3:A3"
    'Pour une plage de cellules, utilisez:
    'C'ellule = "A4:C10"

    NomFeuille = "essai$"    'n'oubliez pas d'ajouter $ au nom de la feuille.
    'Chemin complet du classeur fermé
    Fichier = ThisWorkbook.Path & "\test2.xlsm"

    Set Source = New ADODB.Connection
    Source.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                "Data Source=" & Fichier & ";Extended Properties=""Excel 12.0;HDR=NO;"";"
    Set Rst = Source.Execute("SELECT * FROM [" & NomFeuille & Cellule & "]""")

    MsgBox "Valeur de la cellule externe: " & Rst(0)

    Rst.Close
    Set Rst = Nothing
    Source.Close
    Set Source = Nothing


End Sub

bonne continuation
 
Vote positif 0 Vote négatif
bonjour
un exemple avec mise en place des formules
VB: 
Option Explicit
'exemple formule de base
'"=IF('C:\Users\polux\DeskTop\Nouveau Dossier\[source.xlsm]Feuil1'!A1<>"""",'C:\Users\polux\DeskTop\Nouveau Dossier\[source.xlsm]Feuil1'!A1,"""")"
Sub test()
    Dim Cel As Range, formule$, chemin$, Pls As Range, feuille$, fichier$
  
  
    'la source
    Set Pls = Range("A1:D34") 'plage de la source a adapter
    feuille = "Feuil1" ' feuille de la source
    'fichier de la source par getopenfilename
    fichier = Application.GetOpenFilename(FileFilter:="Excel Files ( *.xlsx;*.xls;*.xlsm), ( *.xlsx;*.xls;*.xlsm), All Files, *.*", FilterIndex:=1)
  
    ' si on annule pas le dialog
    If fichier <> "" Then
        fichier = Mid(fichier, InStrRev(fichier, "\") + 1) 'nom cout du fichier source pour la formule

        'creation de la formule pour la premiere cellule
        formule = "'" & chemin & "[" & fichier & "]" & feuille & "'!" & Pls.Cells(1).Address(0, 0)
        formule = "=IF(" & formule & "<>""""," & formule & ","""")"

        Debug.Print formule ' pour verif

        'DESTINATION
        With Sheets(1).Range("A1") '1ere cellule de destination( c'est pas obligé que se soit la meme que la source )
          
            'inscription de la formule dans la 1 ere cellule
            .Formula = formule
          
            'on etend la formule vers le bas au meme nombre de ligne que la plage source
            .AutoFill Destination:=.Resize(Pls.Rows.Count, 1), Type:=xlFillDefault
          
            'on etend la formule vers la droite au meme nombre de colonnes que la plage source
            .Resize(Pls.Rows.Count, 1).AutoFill Destination:=.Resize(Pls.Rows.Count, Pls.Columns.Count), Type:=xlFillDefault
          
            'on remplace les formules par les valeurs
            .Resize(Pls.Rows.Count, Pls.Columns.Count).Value = .Resize(Pls.Rows.Count, Pls.Columns.Count).Value
        End With
    End If
End Sub

autre methode avec les macroxl4
ici une cellule ou une plage de cellule
Code: 
Sub récup_une_plage_de_cellules()
    Dim chemin$, fichier$, feuille$, cellule As Range, rang As Range
    chemin = "C:\Users\polux\Desktop"
    fichier = "nombre en lettre Monnaie Euro dollar v 2.0.xlsm"
    feuille = "Feuil1"
    Set rang = Range("A1:B10")
    tablo = (GetVal_on_closed_fich(chemin, fichier, feuille, rang))
    Cells(1, 1).Resize(UBound(tablo), UBound(tablo, 2)) = tablo
End Sub
Sub récup_une_seule_valeur()
    Dim chemin$, fichier$, feuille$, cellule As Range, rang As Range
    chemin = "C:\Users\polux\Desktop"
    fichier = "nombre en lettre Monnaie Euro dollar v 2.0.xlsm"
    feuille = "Feuil1"
    Set rang = Range("E3")
    MsgBox GetVal_on_closed_fich(chemin, fichier, feuille, rang)
  End Sub


'La fonction retourne un string ou tableau
'1 un string si l'argument "rang" est une seule celluleet donc sa valeur
'2 une variable tableau si rang est une plage de cellules  donc les !! valeurs dans une variable tableau

Function GetVal_on_closed_fich(ByVal chemin As String, ByVal fichier As String, ByVal feuille As String, rang As Range) As Variant
    Dim Rc$, tableau(), lig&, col&
    If rang.Cells.Count = 1 Then
        Rc = "R" & rang.Row & "C" & rang.Column
        GetVal_on_closed_fich = ExecuteExcel4Macro("'" & chemin & "\[" & fichier & "]" & feuille & "'!" & Rc)
    Else
        ReDim tableau(1 To rang.Rows.Count, 1 To rang.Columns.Count)
        For Each Cel In rang.Cells
            lig = Cel.Row: col = Cel.Column
            Rc = "R" & lig & "C" & col
            tableau(lig - rang.Row + 1, col - rang.Column + 1) = ExecuteExcel4Macro("'" & chemin & "\[" & fichier & "]" & feuille & "'!" & Rc)
        Next
        GetVal_on_closed_fich = tableau
    End If
End Function
dans la seconde tu peux intégrer 'getopenfilename pour avoir le dialog pour choisir ton fichier

sinon tu a adobconnection mais je vois que Roblochon m'a devancé 😉 mais pour une seule cellule ça fait un peu lourd
 
Dernière édition:
Vote positif 0 Vote négatif
Roblochon à dit:
Re,

Sinon, un lien vers votre cellule est suffisant ou alors votre macro modifiée:
Code: 
Sub extractionValeurCelluleClasseurFerme()


    Dim Source As ADODB.Connection

    Dim ADOCommand As ADODB.Command
    Dim Rst As ADODB.Recordset
    Dim Fichier As String, Cellule As String, Feuille As String

    'Adresse de la cellule contenant la donnée à récupérer
    Cellule = "A3:A3"
    'Pour une plage de cellules, utilisez:
    'C'ellule = "A4:C10"

    NomFeuille = "essai$"    'n'oubliez pas d'ajouter $ au nom de la feuille.
    'Chemin complet du classeur fermé
    Fichier = ThisWorkbook.Path & "\test2.xlsm"

    Set Source = New ADODB.Connection
    Source.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                "Data Source=" & Fichier & ";Extended Properties=""Excel 12.0;HDR=NO;"";"
    Set Rst = Source.Execute("SELECT * FROM [" & NomFeuille & Cellule & "]""")

    MsgBox "Valeur de la cellule externe: " & Rst(0)

    Rst.Close
    Set Rst = Nothing
    Source.Close
    Set Source = Nothing


End Sub

bonne continuation
Cliquez pour agrandir...
 
Vote positif 0 Vote négatif
Re,

Dans le fichier joint,

Un test de solution par PowerQuery (pour exemple) et la macro modifiée pour qu'elle ne ramène que le dernier n° non null de la plage A1:A10000 de la feuille essai du classeur source.
Re changer le chemin vers le répertoire.
VB: 
 Sub extractionValeurCelluleClasseurFerme()


    Dim Source As ADODB.Connection

    Dim ADOCommand As ADODB.Command
    Dim Rst As ADODB.Recordset
    Dim Fichier As String, Cellule As String, Feuille As String

    'Adresse de la cellule contenant la donnée à récupérer
    Cellule = "A3:A3"
    'Pour une plage de cellules, utilisez:
    'C'ellule = "A4:C10"

    nomfeuille = "essai$"    'n'oubliez pas d'ajouter $ au nom de la feuille.
    'Chemin complet du classeur fermé
    Fichier = ThisWorkbook.Path & "\test2.xlsm"

    Set Source = New ADODB.Connection
    Source.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                "Data Source=" & Fichier & ";Extended Properties=""Excel 12.0;HDR=NO;"";"
    Source.CursorLocation = adUseClient
    
    Set Rst = New ADODB.Recordset
    Rst.Open "SELECT * FROM [" & nomfeuille & "A1:A10000] WHERE NOT ISNULL(F1);", Source, adOpenStatic, adLockReadOnly
    If Rst.RecordCount > 0 Then Rst.MoveLast
    'Set Rst = Source.Execute("SELECT * FROM [" & NomFeuille & Cellule & "]""")

    Sheets("Feuil1").Range("B5") = Rst("F1")

    Rst.Close
    Source.Close
    Set Source = Nothing
    Set Rst = Nothing
    Set ADOCommand = Nothing
End Sub

Cordialement
 

Pièces jointes

Vote positif 0 Vote négatif
Roblochon à dit:
Re,

Dans le fichier joint,

Un test de solution par PowerQuery (pour exemple) et la macro modifiée pour qu'elle ne ramène que le dernier n° non null de la plage A1:A10000 de la feuille essai du classeur source.
Re changer le chemin vers le répertoire.
VB: 
Sub extractionValeurCelluleClasseurFerme()


    Dim Source As ADODB.Connection

    Dim ADOCommand As ADODB.Command
    Dim Rst As ADODB.Recordset
    Dim Fichier As String, Cellule As String, Feuille As String

    'Adresse de la cellule contenant la donnée à récupérer
    Cellule = "A3:A3"
    'Pour une plage de cellules, utilisez:
    'C'ellule = "A4:C10"

    nomfeuille = "essai$"    'n'oubliez pas d'ajouter $ au nom de la feuille.
    'Chemin complet du classeur fermé
    Fichier = ThisWorkbook.Path & "\test2.xlsm"

    Set Source = New ADODB.Connection
    Source.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                "Data Source=" & Fichier & ";Extended Properties=""Excel 12.0;HDR=NO;"";"
    Source.CursorLocation = adUseClient
   
    Set Rst = New ADODB.Recordset
    Rst.Open "SELECT * FROM [" & nomfeuille & "A1:A10000] WHERE NOT ISNULL(F1);", Source, adOpenStatic, adLockReadOnly
    If Rst.RecordCount > 0 Then Rst.MoveLast
    'Set Rst = Source.Execute("SELECT * FROM [" & NomFeuille & Cellule & "]""")

    Sheets("Feuil1").Range("B5") = Rst("F1")

    Rst.Close
    Source.Close
    Set Source = Nothing
    Set Rst = Nothing
    Set ADOCommand = Nothing
End Sub

Cordialement
Cliquez pour agrandir...
Roblochon à dit:
Re,

Dans le fichier joint,

Un test de solution par PowerQuery (pour exemple) et la macro modifiée pour qu'elle ne ramène que le dernier n° non null de la plage A1:A10000 de la feuille essai du classeur source.
Re changer le chemin vers le répertoire.
VB: 
Sub extractionValeurCelluleClasseurFerme()


    Dim Source As ADODB.Connection

    Dim ADOCommand As ADODB.Command
    Dim Rst As ADODB.Recordset
    Dim Fichier As String, Cellule As String, Feuille As String

    'Adresse de la cellule contenant la donnée à récupérer
    Cellule = "A3:A3"
    'Pour une plage de cellules, utilisez:
    'C'ellule = "A4:C10"

    nomfeuille = "essai$"    'n'oubliez pas d'ajouter $ au nom de la feuille.
    'Chemin complet du classeur fermé
    Fichier = ThisWorkbook.Path & "\test2.xlsm"

    Set Source = New ADODB.Connection
    Source.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                "Data Source=" & Fichier & ";Extended Properties=""Excel 12.0;HDR=NO;"";"
    Source.CursorLocation = adUseClient
   
    Set Rst = New ADODB.Recordset
    Rst.Open "SELECT * FROM [" & nomfeuille & "A1:A10000] WHERE NOT ISNULL(F1);", Source, adOpenStatic, adLockReadOnly
    If Rst.RecordCount > 0 Then Rst.MoveLast
    'Set Rst = Source.Execute("SELECT * FROM [" & NomFeuille & Cellule & "]""")

    Sheets("Feuil1").Range("B5") = Rst("F1")

    Rst.Close
    Source.Close
    Set Source = Nothing
    Set Rst = Nothing
    Set ADOCommand = Nothing
End Sub

Cordialement
Cliquez pour agrandir...

bonjour,
Je relance ce post, car je dois réussir a augmenter la valeur récupérée de "1" à chaque exécution.
Comment valider "RST("F1").value+1"
j'ai une erreur a chaque fois.
Merci d'avance de vos lumières
 
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

vgendron
  • Résolu(e)
Power Query importer fichier CSV, dont le chemin est dans une cellule Excel
Réponses
11
Affichages
270
oguruma
oguruma
C
  • Question Question
XL 2016 VBA - Mettre en Indice une partie du contenu d'une cellule : problème avec la propriété Font.Subscript
Réponses
2
Affichages
479
crocrocro
C
A
  • Résolu(e)
Microsoft 365 Enregistrer copie d'un fichier avec pour nom le contenu d'une cellule excel (macro)
2
Réponses
15
Affichages
1 K
firecarl
F
K
  • Question Question
Microsoft 365 Récupérer le contenu en texte d'une cellule ayant un format personnalisé (sans VBA)
Réponses
9
Affichages
1 K
Efgé
Efgé
A
  • Question Question
XL 2016 Adapter une image à une cellule
2
Réponses
16
Affichages
2 K
Dudu2
Dudu2
A
  • Résolu(e)
XL 2019 Confirmer la modification d'une cellule avant de la protéger en suite
Réponses
10
Affichages
905
arnoldbrice19
A
P
  • Question Question
Microsoft 365 VBA, source d'une référence
Réponses
2
Affichages
1 K
Daniel Bretelles
Daniel Bretelles
F
  • Question Question
Microsoft 365 Sans VBA - Titre d'un graphique en lien avec le contenu de certaines cellule
Réponses
6
Affichages
717
Deadpool_CC
Deadpool_CC
J
  • Question Question
XL 2019 importer le contenu de plusieurs xlsx dans une même sheet d'un nouveau fichier excel
2 3
Réponses
34
Affichages
5 K
Hasco
Hasco
I
  • Résolu(e)
XL 2010 formule 6 critères ou plus avec renvois selon critères vers le contenu d'une cellule
Réponses
4
Affichages
1 K
inkalla34
I
J
  • Question Question
XL 2013 VBA - ADO - requête fait ouvrir le fichier source 2
Réponses
14
Affichages
1 K
JLE
J
E
  • Résolu(e)
XL 2013 [VBA] Check contenu d'une cellule dans une autre feuille avec un retour via MsgBox
Réponses
10
Affichages
1 K
Eawyne
E
A
  • Question Question
XL 2013 Ouvrir un fichier Excel sur le réseau et coller des valeurs
Réponses
9
Affichages
3 K
sylvanu
sylvanu
J
  • Question Question
XL 2016 Importer données depuis fichier source - VBA
Réponses
0
Affichages
2 K
james7734
J
F
  • Question Question
XL pour MAC MACRO POUR AFFICHER LE DETAIL D'UN TCD à PARTIR D'UNE CELLULE
Réponses
4
Affichages
2 K
florestan75
F
Fredox
  • Question Question
XL 2016 [Résolu] - [VBA] Récupérer le nom de la feuille 1 d'un fichier externe ouvert dans la procédure
Réponses
5
Affichages
2 K
Fredox
Fredox
E
  • Résolu(e)
XL 2016 [VBA] Afficher le contenu d'une Textbox (userform) et d'une Listbox (userform) dans une seule et même cellule d'un tableau
Réponses
2
Affichages
3 K
elx
E
L
  • Résolu(e)
XL 2019 Définir le format d'une MFC en fonction de la mise en forme d'une cellule existante.
Réponses
2
Affichages
1 K
ludovicL
L
M
  • Question Question
Créer un TCD en vba dont le fichier source de données est variable
Réponses
1
Affichages
4 K
chris
chris
S
  • Résolu(e)
XL 2010 VBA Copie plages cellule fichiers sources vers fichier dest
Réponses
6
Affichages
2 K
spike29
S
Retour