Rechercher une formule dans un fichier fermé

Paninak

XLDnaute Nouveau
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
 

Pièces jointes

  • synthese.xls
    74 KB · Affichages: 37

Lolote83

XLDnaute Barbatruc
Re : Rechercher une formule dans un fichier fermé

Re salut,
N'ayant pas réussi à modifier mon dernier post, je mets donc ici la version permettant ou non de faire apparaitre les entêtes de colonnes.
Juste un paramètres en plus.
Voici donc le nouveau code.
Code:
Sub TEST()
    'Call ExtraireCopierCellules("Nom du chemin complet (Fichier compris)", "Onglet du fichier fermé", "Plage a récupérer", False, "Cellule a/c de laquelle seront copiées les données")
    Call ExtraireCopierCellules("C:\MesDocuments\Paninak.xlsx", "Feuil1", "A1:F100", False, "H7")
End Sub

Sub ExtraireCopierCellules(ByVal xNomPathFile As String, ByVal xOnglet As String, ByVal xPlage As String, xEntete As Boolean, 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)
    '  xEntete      = Indiquer True / False si on veut ou pas récupérer les entêtes de données
    '  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
        '----------------------------------------------------------------
        
        '---------------------------------------------------- RECUPERATION DES ENTESTES
        If xEntete = True Then
            For F = 1 To xCol
                'Précision : Si l'entête est vierge, la macro inscrira F? (Field n°) à la place
                Cells(xLig2, xCol2 - 1 + F) = Rst.Fields(F - 1).Name
            Next F
            xLig2 = xLig2 + 1
        End If
        '---------------------------------------------------- RECUPERATION DU RESTE DES DONNEES
        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
 

Lolote83

XLDnaute Barbatruc
Re : Rechercher une formule dans un fichier fermé

Salut Paninak,
Merci pour cette réponse.
Je vais l'utiliser dans mon programme.
Par contre le code diffusé dans mon post#2 fonctionne aussi, et ne fait pas, de mémoire, référence à des références spécifiques telles que :
- Microsoft ActiveX Data Objects x.x Library
- Microsoft ADO Ext. 6.0 for DDL and Security
De plus, je pense aussi que le code du post#2 est plus rapide car aucune boucle est nécessaire pour copier les données.
A toi de voir lequel te convient le mieux
@+ Lolote83
 

Discussions similaires

Réponses
6
Affichages
193
  • Question
Microsoft 365 Tableau
Réponses
24
Affichages
682

Statistiques des forums

Discussions
314 644
Messages
2 111 529
Membres
111 189
dernier inscrit
Laurent.