IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

Récupérer des informations d'un autre classeur sans l'ouvrir [XL-2010]


Sujet :

Macros et VBA Excel

  1. #1
    Membre du Club
    Homme Profil pro
    Automaticien
    Inscrit en
    août 2011
    Messages
    24
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Doubs (Franche Comté)

    Informations professionnelles :
    Activité : Automaticien
    Secteur : Industrie

    Informations forums :
    Inscription : août 2011
    Messages : 24
    Points : 44
    Points
    44
    Par défaut Récupérer des informations d'un autre classeur sans l'ouvrir
    Bonjour,

    Je souhaite récupérer des informations dans plusieurs classeurs. Mon problème est qu'actuellement, j'ouvre mon classeur (l'ouverture de ce fichier prend un certain temps), je récupère les informations et je referme le fichier.

    Existe-t-il un moyen de récupérer les information d'un fichier excel sans ouvrir son interface graphique?

    Code actuel:
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
        Dim objWorkbookmain As Workbook, objWorkbook1 As Workbook
        Dim chemin As String
     
        Set objWorkbookmain = Application.ActiveWorkbook
        chemin = objWorkbookmain.Path
        Set objWorkbook1 = Application.Workbooks.Open(chemin & "\1.xls")
        objWorkbookmain.Sheets(1).Cells(1, 1) = objWorkbook1.Sheets(1).Cells(1, 1)
        objWorkbook1.Close
    L'idée est de revoir la lignes 6. J'ai aussi essayé avec .Add mais le résultat est semblable.

    Merci d'avance

    Manu

  2. #2
    Expert éminent
    Homme Profil pro
    Inscrit en
    août 2010
    Messages
    3 453
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations forums :
    Inscription : août 2010
    Messages : 3 453
    Points : 6 865
    Points
    6 865
    Par défaut
    Bonjour,

    Voilà une piste. Exécute la proc "Test" en adaptant les valeurs. Attention, dans une même colonne les valeurs doivent être de même nature (string avec string ou long avec long, etc...) :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
     
    Sub ConnectCLasseur(ConnectCL As Object, _
                        Fichier As String, _
                        Optional Rs)
     
        Set ConnectCL = CreateObject("ADODB.Connection")
     
        If Not IsMissing(Rs) Then
            Set Rs = CreateObject("ADODB.Recordset")
        End If
     
        'HDR > YES ou NO; entêtes de colonnes
        'IMEX > 1 lecture seule, 2 lecture/écriture
        ConnectCL.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                  "Data Source=" & Fichier & ";" & _
                  "Extended Properties=""Excel 8.0;HDR=NO;IMEX= 1;"""
     
    End Sub
     
    Function RecupValeur(Classeur As String, _
                         NomFeuille As String, _
                         Cellule As String) As Variant()
     
        Dim ConnectCL As Object
        Dim Rs As Object
        Dim Champ As Object
        Dim Tbl() As Variant
        Dim I As Integer
     
        'connecxion
        ConnectCLasseur ConnectCL, Classeur, Rs
        'lecture
        With Rs
            .CursorType = 1
            .LockType = 3
            .Open "SELECT * FROM `" & NomFeuille & "$" & _
            Cellule & "` ", ConnectCL
     
            Do Until .EOF
     
                For Each Champ In .Fields
     
                    I = I + 1
                    ReDim Preserve Tbl(1 To I)
                    Tbl(I) = Champ.Value
     
                Next
     
                .MoveNext
     
            Loop
     
            'ValeurCellule = .Fields(0).Value
     
        End With
     
        ConnectCL.Close
     
        RecupValeur = Tbl
     
        Set Rs = Nothing
        Set ConnectCL = Nothing
        Set Champ = Nothing
     
    End Function
     
     
    Sub Test()
     
        Dim Retour() As Variant
        Dim I As Integer
     
        Retour = RecupValeur("D:\Classeur.xls", _
                            "Feuil1", _
                            "B1:C22")
     
     
        For I = 1 To UBound(Retour)
            Debug.Print Retour(I)
        Next I
     
    End Sub
    Hervé.

  3. #3
    Membre du Club
    Homme Profil pro
    Automaticien
    Inscrit en
    août 2011
    Messages
    24
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Doubs (Franche Comté)

    Informations professionnelles :
    Activité : Automaticien
    Secteur : Industrie

    Informations forums :
    Inscription : août 2011
    Messages : 24
    Points : 44
    Points
    44
    Par défaut
    J'ai malheureusement quelques colonnes dans lesquelles on retrouve du String et du Long.

    J'ai tout de même une petite idée pour bidouiller le code pour extraire les informations quelque-soit le type d'information (qu'il soit en Long ou en String). Mais avant cela, je crois que je vais avoir besoin de relire quelques tutos sur MySQL.

    Si ça intéresse quelqu'un je posterai mon code... Si j'y arrive...

    En tout cas merci bien Theze.

  4. #4
    Invité
    Invité(e)
    Par défaut
    Bonjour

    Quelques informations complémentaires : Lire et écrire dans les classeurs fermés

    Philippe

  5. #5
    Membre du Club
    Homme Profil pro
    Automaticien
    Inscrit en
    août 2011
    Messages
    24
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Doubs (Franche Comté)

    Informations professionnelles :
    Activité : Automaticien
    Secteur : Industrie

    Informations forums :
    Inscription : août 2011
    Messages : 24
    Points : 44
    Points
    44
    Par défaut
    Merci, pour les informations Philippe. Je me permets donc de corriger le code de Theze. (voir ligne 15)
    Attention! Le résultat de ces fonctions ne renvoie que des variables de type String.

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    Sub ConnectCLasseur(ConnectCL As Object, _
                        Fichier As String, _
                        Optional Rs)
     
        Set ConnectCL = CreateObject("ADODB.Connection")
     
        If Not IsMissing(Rs) Then
            Set Rs = CreateObject("ADODB.Recordset")
        End If
     
        'HDR > YES ou NO; entêtes de colonnes
        'IMEX > 1 lecture seule, 2 lecture/écriture
        ConnectCL.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                  "Data Source=" & Fichier & ";" & _
                  "Extended Properties=""Excel 8.0;HDR=NO;IMEX=1;"""
     
                  ' ############ Ligne à l'origine ############
                  '"Extended Properties=""Excel 8.0;HDR=NO;IMEX= 1;"""
                  ' C'est juste l'espace entre le 'IMEX=' et le '1;' qui est en trop 
    End Sub
     
    Function RecupValeur(Classeur As String, _
                         NomFeuille As String, _
                         Cellule As String) As Variant()
     
        Dim ConnectCL As Object
        Dim Rs As Object
        Dim Champ As Object
        Dim Tbl() As Variant
        Dim I As Integer
     
        'connecxion
        ConnectCLasseur ConnectCL, Classeur, Rs
        'lecture
        With Rs
            .CursorType = 1
            .LockType = 3
            .Open "SELECT * FROM `" & NomFeuille & "$" & _
            Cellule & "` ", ConnectCL
     
            Do Until .EOF
     
                For Each Champ In .Fields
     
                    I = I + 1
                    ReDim Preserve Tbl(1 To I)
                    Tbl(I) = Champ.Value
     
                Next
     
                .MoveNext
     
            Loop
     
            'ValeurCellule = .Fields(0).Value
     
        End With
     
        ConnectCL.Close
     
        RecupValeur = Tbl
     
        Set Rs = Nothing
        Set ConnectCL = Nothing
        Set Champ = Nothing
     
    End Function
     
     
    Sub Test()
     
        Dim Retour() As Variant
        Dim I As Integer
     
        Retour = RecupValeur("D:\Classeur.xls", _
                            "Feuil1", _
                            "B1:C22")
     
     
        For I = 1 To UBound(Retour)
            Debug.Print Retour(I)
        Next I
     
    End Sub
    Et voilà, ça fonctionne...
    Merci Theze et Philippe.

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. Récupérer des valeurs d´un autre classeur sans l´ouvrir
    Par jguenot dans le forum Macros et VBA Excel
    Réponses: 1
    Dernier message: 14/05/2009, 16h43
  2. récupérer des informations d'une feuille et les placer dans une autre
    Par winclass dans le forum Macros et VBA Excel
    Réponses: 5
    Dernier message: 16/12/2008, 22h34
  3. Réponses: 2
    Dernier message: 12/06/2008, 11h48
  4. Récupérer des informations d'un autre site web
    Par divad dans le forum Langage
    Réponses: 7
    Dernier message: 01/05/2008, 23h01
  5. Réponses: 4
    Dernier message: 26/07/2006, 11h38

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo