Rechercher une formule dans un fichier fermé

[Paninak]

Bonsoir le forum

Grâce à l'aide Excel, j'ai appris à récupérer le contenu d'une cellule dans un fichier fermé et le copier dans mon fichier ouvert en utilisant les connexions ADO.

Mon problème est que je voudrais faire une recherche d'un type de cellule particulier avant de la copier. Je recherche toutes les cellules d'une colonne donnée contenant une formule.

J'ai bien pensé à récupérer chaque cellule de la colonne pour l'analyser avant de la copier, mais je ne récupère que la valeur. C'est bien la valeur que je veux, mais je voudrais m'assurer d'abord qu'il s'agit bien d'un total par la formule "=SUM(...)".
De plus, le fichier exemple que j'ai récupéré (merci à michelxld) sur l'aide fonctionne bien mais avec une requête qui fait référence à une plage nommée dans le gestionnaire de noms et je ne sais pas comment changer la requête pour ne pas passer par le gestionnaire de noms mais fixer une plage directement.

Mes explications sont un peu confuses mais le fichier joint est plus clair. Il y a deux méthodes présentées. J'utilise la seconde. Mes questions sont juste devant les lignes de code concernées.
Le fichier exemple utilise d'autres fichiers de données pour le test que je ne joins pas. Le code est clair sur ce qu'il fait.

Merci à tous

 

[Lolote83]

Re : Rechercher une formule dans un fichier fermé

Salut,
Voici le code que j'utilise pour la récupération de données dans un fichier fermé.

mais avec une requête qui fait référence à une plage nommée dans le gestionnaire de noms et je ne sais pas comment changer la requête pour ne pas passer par le gestionnaire de noms mais fixer une plage directement

Voici

Sub LireFichierFermé()
    Dim texte_SQL As String
    Dim xChemin As String
    Dim xFichier As String
    Dim xOnglet As String
    Dim xPlage As String
    Application.ScreenUpdating = False
    'Définition des variables
        xChemin = ThisWorkbook.Path
        xFichier = "TOTO.xlsx"
        xOnglet = "Feuil1"
        xPlage = "A2:O32"
    'Connexion ADO
        Set Source = CreateObject("ADODB.Connection")
        'Avant XL 2007
            'Source.Open "Provider=Microsoft.Jet.OLEDB.4.0;data source=" & xChemin & "\" & xFichier & ";Extended Properties=""Excel 8.0;HDR=No;"";"
        'Après XL 2007
        If Right(xChemin, 1) = "\" Then
            Source.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & xChemin & xFichier & ";Extended Properties=""Excel 12.0;HDR=NO;"";"       'IMEX=1";
        Else
            Source.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & xChemin & "\" & xFichier & ";Extended Properties=""Excel 12.0;HDR=NO;"";"       'IMEX=1";
        End If
    'Exerce la requete ADO sur les donnée à recopier
        texte_SQL = "SELECT * FROM [" & xOnglet & "$" & xPlage & "]"
        Set Requete = CreateObject("ADODB.Recordset")
        Set Requete = Source.Execute(texte_SQL)
    'Ecriture des données lues dans le fichier en cours
        ActiveSheet.Range("B2").CopyFromRecordset Requete
    'Ferme la requete
        Set Requete = Nothing
        Set Source = Nothing
    Application.ScreenUpdating = True
End Sub

On a donc ici non pas une plage nommée via le gestionnaire de nom mais en dur dans le code.

xPlage = "A2:O32"

Pour la suite je regarde mais je ne suis pas sur de pouvoir t'aider plus
@+ Lolote83

 

[Roland_M]

Re : Rechercher une formule dans un fichier fermé

bonsoir,

s'il ne s'agit que d'un seul fichier, qu'est ce qui empêche de l'ouvrir tout simplement !?

 

[Paninak]

Re : Rechercher une formule dans un fichier fermé

Bonsoir,
Merci lolote83. J'ai fini par trouver ce code. C'était la requête qui m'embrouillait, mais j'ai compris finalement comment ça fonctionne et j'utilise la même méthode que dans ton code en faisant passer les arguments par la procédure. J'ai même fini par trouver la méthode pour trouver la dernière ligne du fichier fermé.
Roland_M. Je n'ouvre pas le fichier parce qu'en fait, il y en a plusieurs à lire et puis aussi parce que, comme tous ceux qui s'essaient à la programmation, j'aime la difficulté.
Merci à vous et à ma prochaine difficulté...

 

[Roland_M]

Re : Rechercher une formule dans un fichier fermé

Bonjour,

C'est très bien d'être persévérant,
mais ce serait sympa de mettre ce code que tu as trouvé pour que tout le monde en profite !?
C'est le principe du forum !

 

[Roland_M]

Re : Rechercher une formule dans un fichier fermé

Message enregistré en double ! J'ai dû supprimer celui-ci ! bizarre !?

 

[Paninak]

Re : Rechercher une formule dans un fichier fermé

Bpnjour,
Voici le code que j'ai adapté provenant de l'aide Excel et autres exemples

Sub ExtraireCopierCellules(ByVal NomPathFile As String, _
            ByVal Feuille As String, _
            ByVal Cellule As String, DerLig As Long)
            
    Dim Cn As ADODB.Connection
    Dim Rst As ADODB.Recordset
    Dim ADOCommand As ADODB.Command
    Dim NomFeuille As String
    Dim N As Integer
    
    Set FL1 = Worksheets(Feuille)
    
    ' Vérifier que Feuille existe dans le fichier source
    If OkSheetName(NomPathFile, Feuille) Then
        'Feuille = "Feuil1$" 'ne pas oublier pas d'ajouter $ au nom de la feuille.
        
        'Connexion
        Set Cn = New ADODB.Connection
        'Ouvrir Fichier
        With Cn
            .Provider = "Microsoft.Jet.OLEDB.4.0"
            .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
                & NomPathFile & ";Extended Properties=""Excel 12.0;HDR=YES;"""
            .Open
        End With
        
        'Requête pour récupérer la dernière ligne du classeur fermé
        Set rs = Cn.Execute("SELECT count(*) as nb FROM [" & Feuille & Cellule & "]")
        'Dernière ligne
        N = rs("nb") + 1
        'Modifier la plage recherchée
        Cellule = Left(Cellule, 4) & N
        'Requête pour lire la plage recherchée
        Set ADOCommand = New ADODB.Command
        With ADOCommand
            .ActiveConnection = Cn
            .CommandText = "SELECT * FROM [" & Feuille & Cellule & "]"
        End With
                      
        Set Rst = New ADODB.Recordset
        Rst.Open ADOCommand, , adOpenKeyset, adLockOptimistic
                      
        Set Rst = Cn.Execute("[" & Feuille & Cellule & "]")
        
        'Dernière ligne du classeur ouvert
        N = DerLig
        'Copier l'enregistrement
        Do While Not Rst.EOF 'boucle sur les données
            'Si non vide
            If Rst.Fields(0).Value <> "" Then
                Cells(N, 1) = Rst.Fields(0).Value
                Cells(N, 2) = Rst.Fields(1).Value - 1
                Cells(N, 3) = Rst.Fields(4).Value
                Cells(N, 4) = Rst.Fields(3).Value
                N = N + 1
                ' Changement de semaine
                
                
            End If
            'Prochaine ligne
            Rst.MoveNext
        Loop
        
        'Fermer
        Rst.Close
        Cn.Close
        Set Cn = Nothing
        Set Rst = Nothing
        Set ADOCommand = Nothing
    End If
        
End Sub

Private Function OkSheetName(FullPathFile As String, SheetName As String) As Boolean
Dim Cn As ADODB.Connection
Dim oCat As ADOX.Catalog
Dim Tbl As Object


Set Cn = New ADODB.Connection
SheetName$ = SheetName$ & "$"
With Cn
    .Provider = "Microsoft.Jet.OLEDB.4.0"
    .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
        & FullPathFile$ & ";Extended Properties=""Excel 12.0;HDR=YES;"""
    .Open
End With

Set oCat = New ADOX.Catalog
Set oCat.ActiveConnection = Cn

For Each Tbl In oCat.Tables
    If Mid$(Tbl.Name, 2, Len(Tbl.Name) - 2) Like SheetName Then
        OkSheetName = True
        Exit For
    End If
Next Tbl

Set oCat = Nothing: Cn.Close: Set Cn = Nothing

End Function

 

[Lolote83]

Re : Rechercher une formule dans un fichier fermé

Salut PANINAK, Roland_M,
Merci pour le code transmis mais je n'arrive pas à le faire fonctionner
Tout d'abord, il m'a fallu rajouter la référence Microsoft ActiveX Data Objects x.x Library non mentionnée dans le code sinon j'avais une erreur. Il serait donc utile lorsque l'on diffuse un code, de donner tous les éléments nécessaires à sa bonne exécution, tout le monde ne connais pas assez le VBA pour trouver ce qui ne va pas.

Concernant les paramètres passés, tu as dans la ligne ci-dessous

Sub ExtraireCopierCellules(ByVal NomPathFile As String, ByVal Feuille As String, ByVal Cellule As String, DerLig As Long)

- NomPathFile = il s'agit bien du chemin et du nom du fichier à lire sans l'ouvrir ?
- Feuille = il s'agit bien de la feuille sur laquelle tu veux lire les données ? (avec $ à la fin si j'ai bien compris)
- Cellule = sous quelle forme doit être renseigné cette donnée ?
- Derlig = sous quelle forme doit être renseigné cette donnée ?

Bref, malgré le rajout de cette référence, j'ai toujours une erreur à :

Set FL1 = Worksheets(Feuille)

Erreur d'exécution '9':
L'indice n'appartient pas à la sélection.
Même si je décide ne ne pas la traiter, donc cochée comme commentaire, j'ai de nouveau une erreur sur la ligne

Set rs = Cn.Execute("SELECT count(*) as nb FROM [" & Feuille & Cellule & "]")

Erreur d'xécution '-2147217865 (80040e37'
Le moteur de base de données Microsoft Access n'a pas pu trouver l'objet Export$A1. Vérifier ....
Sachant que ma feuille passée en paramètre est donc Export$ et ma cellule A1

Peux tu éventuellement apporter plus de précision
Merci
@+ Lolote83

 

[Paninak]

Re : Rechercher une formule dans un fichier fermé

Concernant les paramètres passés, tu as dans la ligne ci-dessous
Sub ExtraireCopierCellules(ByVal NomPathFile As String, ByVal Feuille As String, ByVal Cellule As String, DerLig As Long)
- NomPathFile = il s'agit bien du chemin et du nom du fichier à lire sans l'ouvrir ?
- Feuille = il s'agit bien de la feuille sur laquelle tu veux lire les données ? (avec $ à la fin si j'ai bien compris)
- Cellule = sous quelle forme doit être renseigné cette donnée ?
- Derlig = sous quelle forme doit être renseigné cette donnée ?

NomPathFile est bien le chemin + nom de fichier sous la forme c:/repertoire/nomFile.xlsm
Feuille est bien le nom de la feuille, mais j'y ajoute le $ final que dans la fonction OkSheetName
Cellule est sous la forme string "A15" ou "D4"
Derlig est un long qui désigne le numéro de la ligne, juste pour réadapter le contenu de Cellule:

N = rs("nb") + 1 'Trouve la dernière ligne du fichier fermé

Avant: "A1100"
Cellule = Left(Cellule, 4) & N
Après : "A1" & N


Je déclare aussi la référence "Microsoft ADO Ext. 6.0 for DDL and Security", mais cela ne devrait pas jouer sur cette fonction.

Je pense que l'erreur est là:
'Déclaration du classeur ouvert. Mes deux déclarations sont Public mais ce n'est pas obligatoire.
Dim ClMois As Workbook
Dim FL1 As Worksheet
Set ClMois = ActiveWorkbook
Set FL1 = ClMois.Sheets(NomFeuille)

NomFeuille étant le nom de la feuille sous cette forme "Feuil1"

J'affecte FL1 pour Cells(N, 1)

Sinon FL1.Cells(N, 1) ou ClMois.Sheets(NomFeuille).Cells(N, 1)

 

[Paninak]

Re : Rechercher une formule dans un fichier fermé

Avant: "A1100"
Cellule = Left(Cellule, 4) & N
Après : "A1" & N

lire

 "A1:A1000"

 

[Roland_M]

Re : Rechercher une formule dans un fichier fermé

Bonjour,

Paninak tant que tu es là, quelle est l'utilité de Set FL1 = Worksheets(Feuille) ?
je ne le retrouve nul part dans le Sub !?

ainsi que NomFeuille !?

et ici: SheetName$ = SheetName$ & "$" < SheetName$ est censé avoir déjà le signe $
il faudrait un test: If Right(SheetName$,1)<>"$" then . . . rajouter

ici tu peux utiliser ceci:

        'Connexion et ouverture fichier
        Set Cn = New ADODB.Connection
        If Int(Val(Application.Version)) < 12 Then '< Excel2007
           Cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data source=" & NomPathFile & ";Extended Properties=""Excel 8.0;HDR=YES;""" ';HDR=No;IMEX=1"""
        Else
           Cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & NomPathFile & ";Extended Properties=""Excel 12.0;HDR=YES;""" ';HDR=No;IMEX=1"""
        End If

idem dans le 2 Sub ! test feuille !

 

[Lolote83]

Re : Rechercher une formule dans un fichier fermé

Re salut,
Je travaille justement sur ton code, et j'avance petit à petit.
Je ne comprends toujours pas l'utilité de la ligne

Set FL1 = Worksheets(Feuille)

car sans cette ligne cela fonctionne.

Merci aussi pour la référence Microsoft ADO Ext. 6.0 for DDL and Security car sans elle, la fonction appelée par la ligne suivante ne fonctionnait pas

If OkSheetName(NomPathFile, Feuille) Then

De plus, dans ton code, si tu as plus de 4 colonnes a tester, on est un peu coincé

Cells(N, 1) = Rst.Fields(0).Value 'Lecture 1ère colonne
Cells(N, 2) = Rst.Fields(1).Value 'Lecture 2ème colonne
Cells(N, 3) = Rst.Fields(4).Value 'Lecture 3ème colonne
Cells(N, 4) = Rst.Fields(3).Value 'Lecture 4ème colonne

donc j'ai réussi aussi a récupérer la dernière colonne pour tester jusqu’où peut on aller.
C'est pourquoi, dans le code fourni au post#2, on est pas limité.
Je mettrais le code final avec explication plus tard.
Merci encore
@+ Lolote83

 

[Paninak]

Re : Rechercher une formule dans un fichier fermé

Je ne comprends toujours pas l'utilité de la ligne
Set FL1 = Worksheets(Feuille)

Je travaille sur plusieurs feuilles, donc je renseigne la feuille sur laquelle je veux que le résultat s'inscrive, sinon, c'est la feuille active qui reçoit le résultat, d'où le Set FL1 = Worksheets(Feuille). FL1 est une déclaration Public et n'est donc pas dans le Sub.

Dim NomFeuille est une scorie, on peut l'effacer.

S'il y a plusieurs colonnes à récupérer puis tester, il faut les inclure dans Cellule :

le Rst va récupérer cette plage

Cellule = "A1:X:" & Derlig

Ensuite, tu testes en bouclant sur :

  Dim Col As Integer
        Col = 0
        Do While Not Rst.EOF 'boucle sur les données
            'Si non vide
            If Rst.Fields(Col).Value <> "" Then
                'Ecrit sur la feuille active ou sur celle qui a été affectée par un Set = Worksheets(NomFeuille)
                Cells(N, 1) = Rst.Fields(Col).Value
                Col = Col + 1
                N = N + 1
        Loop

Je n'ai pas testé mais je pense que cela devrait être bon.

Désolé pour le manque d'explication, d'ordinaire c'est plutôt moi qui les reçois.

 

[Paninak]

Re : Rechercher une formule dans un fichier fermé

 Cells(N, Col + 1) = Rst.Fields(Col).Value

Plutôt comme ça si tu veux que cela recopie sur les mêmes colonnes, sachant que si Rst.Fields(Col) accepte Col = 0,
Cells(N, 0) fera une erreur

 

[Lolote83]

Re : Rechercher une formule dans un fichier fermé

Salut Paninak, Roland_M,
Comme dit dans le post #12, j'ai retravaillé le code fourni par Paninak, en y ajoutant au tant que possible des annotations.
Dans cette version, je récupère non seulement la dernière ligne du fichier fermé mais aussi la dernière colonne si en paramètre la plage de données en supérieure à ce que l'on souhaite récupérer.

Je m'explique :
Exemple 1: Plage à récupérer = A1:F100. Si le fichier comporte plus de colonne et/ou plus de ligne, seule cette plage sera récupérée.
Exemple 2: Plage à récupérer = A1:F100. Si le fichier comporte moins de colonne et/ou plus de ligne, la plage est recalculée pour ne récupérer que les lignes et colonnes contenues dans le fichier

Voici donc le code général ainsi qu'un code appelant cette procédure.

Sub TEST()
    'Call ExtraireCopierCellules("Nom du chemin complet (Fichier compris)", "Onglet du fichier fermé", "Plage a récupérer", "Cellule a/c de laquelle seront copiées les données")
    Call ExtraireCopierCellules("C:\Mes documents\Paninak.xsl", "Feuil1", "A1:F100", "H7")
End Sub

Sub ExtraireCopierCellules(ByVal xNomPathFile As String, ByVal xOnglet As String, ByVal xPlage As String, xCellule As String)
    
    '----------------------------------------------------------------------
    '                                                      POUR INFORMATION
    '
    '  Nécessite la référence Microsoft ActiveX Data Objects x.x Library
    '
    '  xNomPathFile = Nom du chemin et du fichier complet
    '  xOnglet      = Nom de l'onglet du classeur fermé
    '  xPlage       = Plage de cellule à lire (Doit dépasser la valeur de la dernière ligne et colonne pour pouvoir récupérer l'intégralité Ligne et Colonne)
    '  xCellule     = Cellule (du fichier ouvert) à partir de laquelle les données seront copiées
    '----------------------------------------------------------------------
    
    Dim Cn As ADODB.Connection
    Dim Rst As ADODB.Recordset
    Dim ADOCommand As ADODB.Command
    
    If OkSheetName(xNomPathFile, xOnglet) Then      'Vérifier que l'onglet existe dans le fichier source
        '----------------------------------------------------------------
        '                                 Ouvrerture VIRTUELLE du Fichier
        '----------------------------------------------------------------
        Set Cn = New ADODB.Connection               'Connexion
        With Cn
            .Provider = "Microsoft.Jet.OLEDB.4.0"
            .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & xNomPathFile & ";Extended Properties=""Excel 12.0;HDR=YES;"""
            .Open
        End With
       
        '----------------------------------------------------------------
        '                                                         Requête
        '----------------------------------------------------------------
        Set ADOCommand = New ADODB.Command                          'Requête pour lire la xPlage recherchée
        With ADOCommand
            .ActiveConnection = Cn
            .CommandText = "SELECT * FROM [" & xOnglet & "$" & xPlage & "]"
        End With
        Set Rst = New ADODB.Recordset
        Rst.Open ADOCommand, , adOpenKeyset, adLockOptimistic
        xLig = Rst.RecordCount + 1                                  'Permet de connaitre la dernière ligne du fichier fermé
        xCol = Rst.Fields.Count                                     'Permet de connaitre la dernière colonne du fichier fermé
        xLettreColonne = Split(Cells(1, xCol).Address, "$")(1)      'Transforme la valeur de la colonne en lettre Excel
        xPlage = Left(xPlage, 3) & xLettreColonne & xLig            'Redefini la Plage d'origine en nouvelle Plage
        Set Rst = Cn.Execute("[" & xOnglet & "$" & xPlage & "]")
        
        '----------------------------------------------------------------
        '  Détermine la ligne et la colonne ou seront copiées les données
        '----------------------------------------------------------------
        For F = 1 To Len(xCellule)
            If IsNumeric(Mid(xCellule, F, 1)) = True Then
                xPos = F
                Exit For
            End If
        Next F
        xLig2 = Val(Mid(xCellule, xPos, 10))
        xCol2 = Range(Left(xCellule, xPos - 1) & 1).Column          'Transforme la lettre de la colonne en valeur chiffrée
        
        '----------------------------------------------------------------
        '                        Copie les données lues a/c de la cellule
        '----------------------------------------------------------------
        Do While Not Rst.EOF                                'Boucle sur les données
            If Rst.Fields(0).Value <> "" Then
                For F = 1 To xCol
                    Cells(xLig2, xCol2 - 1 + F) = Rst.Fields(F - 1).Value   'Passe en revue toutes les colonnes
                Next F
                xLig2 = xLig2 + 1
            End If
            Rst.MoveNext                                    'Prochaine ligne
        Loop
        '----------------------------------------------------------------
        '                                      Fermeture de la connection
        '----------------------------------------------------------------
        Rst.Close
        Cn.Close
        Set Cn = Nothing
        Set Rst = Nothing
        Set ADOCommand = Nothing
    End If
End Sub

Private Function OkSheetName(FullPathFile As String, SheetName As String) As Boolean
    '----------------------------------------------------------------------
    '                                                      POUR INFORMATION
    '
    '  Nécessite la référence Microsoft ADO Ext. 6.0 for DDL and Security
    '----------------------------------------------------------------------
    
    Dim Cn As ADODB.Connection
    Dim oCat As ADOX.Catalog
    Dim Tbl As Object
    Set Cn = New ADODB.Connection
    xOnglet = SheetName & "$"
    With Cn
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & FullPathFile$ & ";Extended Properties=""Excel 12.0;HDR=YES;"""
        .Open
    End With
    Set oCat = New ADOX.Catalog
    Set oCat.ActiveConnection = Cn
    For Each Tbl In oCat.Tables
        If Tbl.Name Like xOnglet Then
            OkSheetName = True
            GoTo Suite
        End If
    Next Tbl
    MsgBox "L'onglet   " & SheetName & "   ne se trouve pas dans le fichier   " & FullPathFile, vbCritical, "PAS D'ONGLET DANS LE FICHIER SPECIFIE"
Suite:
    Set oCat = Nothing: Cn.Close: Set Cn = Nothing
End Function

De plus, un MessageBox indique si absence du nom de l'onglet dans le fichier à lire. Cette fonction n'était pas indiquée et une personne n'aurait peut être pas compris pourquoi le programme ne s'exécutait pas

MsgBox "L'onglet   " & SheetName & "   ne se trouve pas dans le fichier   " & FullPathFile, vbCritical, "PAS D'ONGLET DANS LE FICHIER SPECIFIE"

Par contre, et petite précision, la ligne d'entête n'est pas récupérée, donc ajuster la plage en concéquence
Je regarde donc si on peut la récupérer.
Voili voilà, en espérant que les informations citées dans le code sont suffisamment claires pour ceux et celles qui souhaiteraient utiliser ce code
@+ Lolote83