Extraire des Données à partir de plusieurs fichiers avec VB.

[Rakos]

Bonjour,

Je me suis attaqué aux TCD pour automatiser nos process de facturation. Grace à vos conseils je m’en suis dépatouillé. Mais là, je suis devant une question qui dépasse de loin mes compétences.

Il faut que je réalise un extraction sur plusieurs fichiers fermés
je crois bien que pour réaliser cette prouesse, il faut passer par Visual Basic. Et moi, je ne suis qu’un simple utilisateur d’excel. J’ai cherché dans ce forum des cas similaires, mes faibles compétences en la matière ne m’ont par permis de les adapter à mon cas.

Je vais essayer d’être aussi clair que possible :
Dans notre arborescence nous avons un dossier CLIENTS dans le quel chaque client a un dossier.

Chaque dossier client comporte des Dossiers : Factures, Contrats, Etat de .., etc.

Naturellement chaque dossier comporte des fichiers.

Nous visons à exporter
- les lignes de la colonne P, renseignés de AG,CL ou NA
- de l’onglet commençant par le mot Etat
- du fichier commençant par le mot Etat
- du dossier commençant par le mot Etat
- de tous les clients se trouvant le répertoire suivant : C:\Documents and Settings\Mobile\Mes documents\My Dropbox\Projet 1\CLIENTS

Pour vous aider voila les commandes en language parlé que je suis incapable d’écrir en VB:

1) Va dans C:\Documents and Settings\Mobile\Mes documents\My Dropbox\Projet 1\CLIENTS
2) Va dans le premier classeur dans l’ordre Albhabetique et cherche un ficher commencant par le mot ETAT
3) Dans ce fichier cherche un onglet commençant par le mot ETAT
4) Dans cet onglet cherche dans la colonne P : AG, CL et NA. Si trouvé, exprote la Cellule H4 puis toute la ligne de A à U, puis continue à checher AG,CL et NA, si trouvé exporte de la même façon, si non cherche un autre fichier commençant par ETAT.
5) Va dans le dossier du prochain client et recommence à partir de l’Etape 3, et ce jusqu’au dérnier client.

Je joins 2 fichiers, un pour montrer un exemple de fichier source, l’autre pour montrer le fichier d’extraction de tous les fichiers source.

J’espère avoir été clair, sinon n’hésitez pas à me demander des informations complémentaires.

Si vos compétences vous permettent de m’aider je vous en remercie d’avance.

Cordialement

RAKOS.

 

[exene]

Re : Extraire des Données à partir de plusieurs fichiers avec VB.

Bonjour,
Peut être pourrais tu aller sur le site de frederic sigonneau, il y a des codes exemples pour travailler avec des classeurs fermés.Ci-joint le lien

Ce site n'existe plus

Bon courage

 

[ChTi160]

Re : Extraire des Données à partir de plusieurs fichiers avec VB.

Salut Racos
Bonjour le fil
Bonjour le Forum

je vois que tu es sous office 2007

donc tu peux t'aider de ce lien

MichelXLD : Un complment FileSearch pour Excel 2007

je pense que tu devrais avoir de l'aide , sinon je vois ce que je peux faire des que possible (boulot aujourd'hui et demain )Lol

Bonne Journée

 

[Rakos]

Re : Extraire des Données à partir de plusieurs fichiers avec VB.

Bonjour,

Merci de ces liens, je me rends compte que j'ai vraiment besoin d'une formation en la matière. J'ai un petit budget de formation de 1000€, connaissez-vous quelqu'un étant un organisme de formation pouvant me dispenser une formation à distance par Skype ou autre ?

Cordialement,

Rakos.

 

[exene]

Re : Extraire des Données à partir de plusieurs fichiers avec VB.

Bonjour Rakos,

Je suis comme toi, je galère avec les fichiers fermés, j'attendais beaucoup de ta discussion avec chTI160, mais je suis attristé par sa volonté de quitter le forum. Je le cite
"Pour DavidXLD ( Rien contre le Forum , ni contre toi que je remercie encore du travail fait sur ce Forum)
Juste l'ambiance qui change un peu Arffff pas grave !!!!!

je te demanderai quand même de résilier mon compte , je vais passé à autre chose et peut être qu'un jour je me réinscrirai Lol

Merci encore je passerai quand même en candidat libre , voir ce qui ce passe Lol"



J'ai bien l'impression que nous allons continuer à nous torturer les méninges sans son aide.

Bonne journée cependant.

 

[Rakos]

Re : Extraire des Données à partir de plusieurs fichiers avec VB.

Bonjour,

J’ai enfin suivi ma formation VBA et avec l’aide du formateur j’ai pu écrire le code qui marche très bien.

Ce code permet d’agir dans un répertoire sur plusieurs fichiers fermés, extraire des informations selon un critère et de réaliser un tableau récapitulatif.

J’ai le plaisir de le partager avec vous.

Attention cela implique l’installation du module de classefilesearch dans Excel 2007 au préalable. Sinon ça ne fonctionnera pas.

L’installation de ce module est très bien expliquée dans un lien envoyé par ChTi160 dans cette discussion.
Naturellement vous devez faire les adaptations à votre cas, changer le traitement, etc.
Cordialement,

Rakos.

Option Explicit
Public LesFichiers() As String
Public Compteur As Integer
Sub StockageDesFichiersExcelEnMemoire()
'Nécessite d'activer la référence ClFileSearch
'(Dans l'éditeur de macros: Menu Outils/Références)
Dim i As Long
Dim Recherche As ClFileSearch.ClasseFileSearch
Dim Ligne As Integer


Set Recherche = ClFileSearch.Nouvelle_Recherche

With Recherche
'Définit le répertoire de recherche
.FolderPath = "G:\Projet 1\Projet 1 du 7-12-2010\Projet 1\CLIENTS"

'Définit la recherche dans les sous dossiers (True / False)
.SubFolders = True

'Option de tri:
'(Sort_None, sort_Name, sort_Path, sort_Size, sort_DateCreated, sort_LastModified, sort_Type)
'Pas de tri si le paramètre n'est pas spécifié.
.SortBy = sort_Name

'Option pour rechercher un type de fichier
'(Renvoie tous les fichiers si non spécifié)
.Extension = "*.xlsx"

'Execute la recherche
.Execute

'Boucle sur le tableau pour afficher le résultat de la recherche
'(.FoundFilesCount renvoie le nombre de fichiers trouvés)

Compteur = 0
For i = 1 To .FoundFilesCount
'MsgBox .Files(i).strFileName & vbCrLf & .Files(i).strPathName
'Debug.Print .Files(i).strFileName 'nom du fichier
'Debug.Print .Files(i).strPathName 'chemin
'Debug.Print .Files(i).lngSize & " octets" 'taille
'Debug.Print .Files(i).DateCreated 'date création fichier
'Debug.Print .Files(i).DateLastModified 'date dernière modification
'Debug.Print .Files(i).strFileType 'type de fichier

'Debug.Print "---"
ReDim Preserve LesFichiers(Compteur)
If Left(.Files(i).strFileName, 4) = "ETAT" Then
LesFichiers(Compteur) = .Files(i).strPathName & "\" & .Files(i).strFileName
Compteur = Compteur + 1
End If

Next i
End With

' mettre les fichiers dans la colonne A
'Ligne = 1
'For i = 0 To Compteur - 1
'Cells(Ligne, 1).Value = LesFichiers(i)
'Ligne = Ligne + 1
'Next i

Set Recherche = Nothing

'MsgBox "Fin de recherche"

End Sub

Sub TransfertInformations()
Dim MonClasseurSRC As Workbook
Dim MaFeuilleSRC As Worksheet
Dim LigneExploration As Integer
Dim Critere As String
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim NomClient As String

' classeur Destination
Dim MonClasseurDest As Workbook
Dim MaFeuilleDest As Worksheet
Dim LigneReport As Integer
Dim AdresseLigneOrigine As String
Dim AdresseLigneReport As String
Dim Entete As Boolean



' création du classeur de destination
Set MonClasseurDest = Application.Workbooks.Add
MonClasseurDest.SaveAs "ConsolidationGenerale.xlsx"
Set MaFeuilleDest = MonClasseurDest.Worksheets.Add
MaFeuilleDest.Name = "Consolidation"
LigneReport = 1



' Lecture du tableau en séquentiel ( LesFichiers )

For i = 0 To Compteur - 1
Entete = False
' classeur source en cours
Set MonClasseurSRC = Application.Workbooks.Open(LesFichiers(i))
Set MaFeuilleSRC = MonClasseurSRC.Worksheets("Créances")
MaFeuilleSRC.Activate
NomClient = MaFeuilleSRC.Range("H4").Value


' vérifier Colonne P à partir ligne 17
LigneExploration = 17
' début boucle des lignes 17 à n
' mise en place du nom du client


Do While MaFeuilleSRC.Cells(LigneExploration, 1).Value <> ""

' tester le critère AG , CL , NA
Critere = Trim(MaFeuilleSRC.Cells(LigneExploration, 16).Value)

Select Case Critere

Case "AG", "CL", "NA"
If Entete = False Then
MaFeuilleDest.Cells(LigneReport, 1).Value = NomClient
LigneReport = LigneReport + 2
Entete = True
End If

' traitement à faire on récupère la ligne entière ( 17 )
AdresseLigneOrigine = LTrim(Str(LigneExploration)) & ":" & LTrim(Str(LigneExploration))
Rows(AdresseLigneOrigine).Select
'Rows("19:19").Select
Selection.Copy
MaFeuilleDest.Activate
'Sheets("Feuil3").Select
AdresseLigneReport = LTrim(Str(LigneReport)) & ":" & LTrim(Str(LigneReport))
Rows(AdresseLigneReport).Select
'Rows("3:3").Select
'ActiveSheet.Paste
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False

LigneReport = LigneReport + 1

End Select

' réactiver la feuille source
MaFeuilleSRC.Activate

LigneExploration = LigneExploration + 1
Loop
' fin boucle lignes 17 à n


' fermeture du classeur
MonClasseurSRC.Close
Set MonClasseurSRC = Nothing
Set MaFeuilleSRC = Nothing


' passage au prochain classeur source
Next i

MonClasseurDest.Save
MonClasseurDest.Close
Set MonClasseurDest = Nothing
Set MaFeuilleDest = Nothing


End Sub