Compiler des fichiers indentiques dans un répertoire de mon choix

Le samedi 4 février 2017 23:15:20 UTC+1, mcl...@live.fr a écrit  :

Bonsoir à tous,

J'ai un fichier excel qui fonctionnait sous 2003 mais migration sous 2010 . Mais les macros ne fonctionnent plus...
j'arrvive pas à trouver le code qui ne fonctionne plus en X64


O


Declare Function FindWindow32 Lib "user32" Alias "FindWindowA" (ByVal lpC lassName As String, ByVal lpWindowName As String) As Long
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal l pString1 As String, ByVal lpString2 As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseI nfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long


Quelqu'un pourrait-il m'aider si je mets le fichier joint ?

Merci d'avance.
Mclain

http://www.cjoint.com/c/GBewLs5trNa
le fichier en question avec le message d"erreur.

merci

Bonjour,

Si tu es passé en Windows 64 bits,

Il y a 2 déclarations d'API que tu dois adapter :

Declare Function FindWindow32 Lib "user32 à remplacer par :
Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As
String, ByVal lpWindowName As String) As LongPtr

Private Declare Function lstrcat Lib "kernel32 à remplacer par :
Declare PtrSafe Function lstrcat Lib "Kernel32" Alias "lstrcatA" (ByVal lpString1 As String,
ByVal lpString2 As String) As LongPtr

Pour que cela fonctionne bien pour Windows 32 bits et Windows 64 bits, il faut passer par une
compilation conditionnelle.

De plus, la méthode "FileSearch" n'existe plus au-delà de la version Excel 2003
"Set fs = Application.FileSearch"

Par conséquent, ta macro est devenue désuète.

Tu devrais définir ce que tu tentes de réaliser, il y a sûrement d'autres approches moins
lourdes et moins complexes
pour obtenir ce que tu veux.

MichD

Bonjour MichD,
Bonjour la communauté !

J'extrait des données chaque semaine dans un fichier Excel nommé S1-données.xls puis S2-données.xls.
Je veux compiler les données de ces fichiers automatiquement mais que la 1er colonne A reprennes le nom du fichier S1 et que les données se mettent dans les colonnes d'après, puis à la compilation, et à   la suite en colonne B, se trouve le nom du fichier Suivant S2... et ain si de suite
Ainsi, je peux filter mes données comme je veux par Colonne puis trava iller sur les données.
Ce que je pouvais faire avant. Et Excel me demandait le chemin des fichiers à compiler...

Voila ce que je veux et que je ne trouve pas à faire...
Merci !

Ha,
et "on" voudrait que je jette mon 2003 ?
-))

Jacques
" Le vin est au repas ce que le parfum est à la femme."
.
a écrit dans le message de groupe de discussion :
f0d1b3d3-671c-47a8-b647-1f3585e55acc@googlegroups.com...

Bonsoir à tous,

J'ai un fichier excel qui fonctionnait sous 2003 mais migration sous 2010.
Mais les macros ne fonctionnent plus...
j'arrvive pas à trouver le code qui ne fonctionne plus en X64


O


Declare Function FindWindow32 Lib "user32" Alias "FindWindowA" (ByVal
lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal
lpString1 As String, ByVal lpString2 As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As
BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As
Long, ByVal lpBuffer As String) As Long


Quelqu'un pourrait-il m'aider si je mets le fichier joint ?

Merci d'avance.
Mclain


---
L'absence de virus dans ce courrier électronique a été vérifiée par le logiciel antivirus Avast.
https://www.avast.com/antivirus

Bonjour !

Je suis bien d'accord mais au bureau on ne fait toujours comme on veut !

Bon dimanche Jacquouille

Voici un fichier Exemple : http://www.cjoint.com/c/GBfrD6WCe7i

Pour les besoins de l'exemple :

Dans la première feuille du classeur où tu copieras la macro,

Sur la ligne 1 s'affichera le chemin et le nom du fichier et
en dessous à partir de la ligne 2, les données des classeurs.

Pour les besoins de l'exemple, seule la colonne 1 ce la première feuille
de tous les fichiers Excel contenus dans le répertoire de départ et de
ses sous-répertoires seront copiées.

Fichier 1 en colonne1
fichier 2 en colonne 2

Etc.

MichD

J'oubliais, la fonction "ChoixDossier" ne peut pas être exécutée pour les versions
antérieures à 2007.

MichD

Bonsoir MichD,

Merci !
Je voulais tester mais le fichier ne fonctionne pas...corrompu...
Mais au vu de ton explication... je précise..
J'ai 3 fichiers de nom differents mais dont la structure est identique:
semaine1.xls
semaine2.xls
semaine3.xls

Je veux compiler les 3 fichiers mais que la colonne A reprenne le nom du fi chier
semainex pour chaque ligne
cela est-il possible ?

Grand merci pour ton aide

Quand tu es sur le site cjoint.com, lorsque tu demandes "enregistrer le fichier sur ton
ordinateur", remarque dans le nom de la fenêtre l'extension du fichier .xlsx. Ce type de
fichier ne peut pas contenir de macro. Moi, mon fichier a une macro et tu dois modifier
manuellement l'extension du fichier .xlsx pour .xlsm et il va ouvrir normalement.

Voici le code contenu dans le module :

J'ai pris la peine de commenter presque toutes les lignes du code.

La macro inscrit le chemin le nom et le chemin du fichier en ligne 1
et copie la première colonne de la feuille 1 du classeur vers la feuille 1
du classeur où tu copieras cette procédure.

L'essentiel est là... selon la plage que tu as à copier, tu devras modifier légèrement la
macro.

Je crois que tu vas pouvoir t'en sortir avec un peu d'effort.


'Déclaration des variables dans le haut du module standard
Dim FSO As Object
Dim myBaseFolder As Object
Dim myFolder As Object
Dim F As Object
Dim Col As Long
'---------------------------------------------------------------------------------
Sub Compilation_Fichier_Excel()
Dim RépertoireSource As String

Application.ScreenUpdating = False
Application.EnableEvents = False

'********Définir les variables***********
'2 façons de faire, en inscrivant sois-même
'le chemin ou en laissant l'usager choisir.
'RépertoireSource = "C:UsersMichDDownloadsExcel"

'Si tu préfères laisser l'usager choisir le répertoire de départ
'Enlève l'apostrophe devant la ligne de code suivante
RépertoireSource = ChoixDossier
'****************************************
If RépertoireSource = "" Then
MsgBox "Comme vous n'avez pas retenu un répertoire, " & vrcl & Chr(13) & _
"l'opération est annulée.", vbInformation + vbOKOnly, "Attention."
End If

Set FSO = CreateObject("scripting.filesystemobject")

Col = 1
Call FoldersInFolder(RépertoireSource)

ThisWorkbook.Worksheets(1).UsedRange.EntireColumn.AutoFit
Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub
'---------------------------------------------------------------------------------
Sub FoldersInFolder(myFolderName As String)
Dim Fichier As String, Wk As Workbook
Set myBaseFolder = FSO.getfolder(myFolderName)

'Si le dernier caractère du répertoire myFolderName
'ne contient pas "", on doit l'ajouter
If Right(myFolderName, 1) <> "" Then
myFolderName = myFolderName & ""
End If

'premier fichier excel du répertoire
Fichier = Dir(myFolderName & "*.xl*")

'Une boucle sur tous les fichiers excel du répertoire
Do While Fichier <> ""
'Dans la ligne 1, on colle le chemin et le nom du fichier Excel
ThisWorkbook.Worksheets("Feuil1").Cells(1, Col) = myFolderName & Fichier
'On ouvre le fichier identifié
Set Wk = Workbooks.Open(myFolderName & Fichier)
'Avec la première feuille du fichier
'au lieu de l'index, on peut la nommer par son nom si tous
'les fichiers utilisent le même nom pour la feuille.
With Wk.Worksheets(1)
'Définis la plage à copier, soit la première colonne de chaque
'fichier. (Ceci c'était pour le besoin de l'exemple)
'Tu peux choisir la plage de ton choix
Set rg = .Range("A1:A" & .Range("A" & .Rows.Count).End(xlUp).Row)
'copie de la plage définie dans la première feuille
'ou tu as copié cette procédure
rg.Copy ThisWorkbook.Worksheets(1).Cells(2, Col)
'Fermeture du fichier ouvert et ce, sans sauvegarder
Wk.Close False
'Ajoute 1 au compteur pour passer à la colonne suivante...
Col = Col + 1
End With
'On passe au fichier suivant du répertoire
Fichier = Dir()
Loop

'Pour boucler dans tous les sous-répertoires du répertoire principal
For Each myFolder In myBaseFolder.SubFolders
'On appelle en boucle cette même procédure pour
'chacun des fichiers excel des sous-répertoires
Call FoldersInFolder(myFolder.Path)
Next
End Sub
'---------------------------------------------------------------------------------
Function ChoixDossier()
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = ActiveWorkbook.Path & ""
.Show
If .SelectedItems.Count > 0 Then
ChoixDossier = .SelectedItems(1)
Else
ChoixDossier = ""
End If
End With
End Function
'---------------------------------------------------------------------------------







a écrit dans le message de groupe de discussion :
e17e1811-e72b-4e8e-88fa-8c9d25a296b1@googlegroups.com...

Bonsoir MichD,

Merci !
Je voulais tester mais le fichier ne fonctionne pas...corrompu...
Mais au vu de ton explication... je précise..
J'ai 3 fichiers de nom differents mais dont la structure est identique:
semaine1.xls
semaine2.xls
semaine3.xls

Je veux compiler les 3 fichiers mais que la colonne A reprenne le nom du fichier
semainex pour chaque ligne
cela est-il possible ?

Grand merci pour ton aide

Si tu n'as pas encore trouvé comment modifier la procédure... regarde ce qui suit :
Dans la procédure compilation, tu n'as qu'à définir
tous les fichiers que tu veux traiter. Seuls ces fichiers
seront traités même si tu en as plusieurs.

Le répertoire que tu as choisi sera passé à la loupe de même
que tous les sous-répertoires de ce dernier à la recherche des
fichiers que tu auras définis.


'Déclaration des variables dans le haut du module standard
Dim FSO As Object
Dim myBaseFolder As Object
Dim myFolder As Object
Dim F As Object, Arr()
'-------------------------------------------------------------------------------
Sub Compilation_Fichier_Excel()

Dim RépertoireSource As String

Application.ScreenUpdating = False
Application.EnableEvents = False

'********Définir les variables***********
'Liste des fichiers à traiter. Tu peux en ajouter
'autant que tu désires en respectant la syntaxe
Arr = Array("semaine1.xls", "semaine2.xls", _
"semaine3.xls")

'2 façons de faire, en inscrivant sois-même
'le chemin ou en laissant l'usager choisir.
'RépertoireSource = "C:UsersMichDDownloadsExcel"

'Si tu préfères laisser l'usager choisir le répertoire de départ
'Enlève l'apostrophe devant la ligne de code suivante
RépertoireSource = ChoixDossier
'****************************************
If RépertoireSource = "" Then
MsgBox "Comme vous n'avez pas retenu un répertoire, " & vbCrLf & _
"l'opération est annulée.", vbInformation + vbOKOnly, "Attention."
End If

Set FSO = CreateObject("scripting.filesystemobject")

Call FoldersInFolder(RépertoireSource)

ThisWorkbook.Worksheets(1).UsedRange.EntireColumn.AutoFit
Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub
'-------------------------------------------------------------------------------
Sub FoldersInFolder(myFolderName As String)
Dim Fichier As String, Wk As Workbook, Dest As Range
Dim DerLig As Long, DerCol As Long, X As Variant

Set myBaseFolder = FSO.getfolder(myFolderName)

'Si le dernier caractère du répertoire myFolderName
'ne contient pas "", on doit l'ajouter
If Right(myFolderName, 1) <> "" Then
myFolderName = myFolderName & ""
End If

'premier fichier Excel du répertoire
Fichier = Dir(myFolderName & "*.xl*")

On Error Resume Next

'une boucle sur tous les fichiers Excel du répertoire
Do While Fichier <> ""
'vérifie si le fichier fait partie des fichiers définis
X = Application.Match(Fichier, Arr, 0)
'si x est numérique,
If IsNumeric(X) Then
'On ouvre le fichier identifié
Set Wk = Workbooks.Open(myFolderName & Fichier)
'Avec la première feuille du fichier
'au lieu de l'index, on peut la nommer par son nom si tous
'les fichiers utilisent le même nom pour la feuille.
With Wk.Worksheets(1)
'Définis la plage à copier, soit la première colonne de chaque
'fichier. (Ceci c'était pour le besoin de l'exemple)
'Tu peux choisir la plage de ton choix
DerLig = .Cells.Find(What:="*", _
LookIn:=xlValues, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
DerCol = .Cells.Find(What:="*", _
LookIn:=xlValues, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
'Toute la plage de cellules occupées de la feuille
Set Rg = .Range("A1", .Cells(DerLig, DerCol))
End With

'Définis où les données seront copiées
'sur la première feuille du classeur...
With ThisWorkbook.Worksheets(1)
DerLig = .Cells.Find(What:="*", _
LookIn:=xlValues, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row + 1
'Si la feuille est vide, on traite l'erreur...
If Err <> 0 Then
Err = 0
DerLig = 1
End If
Set Dest = .Range("B" & DerLig)
End With
'Copie en colonne A, sur la première ligne où sont
'copies les données,le chemin et le nom du fichier
Dest.Offset(, -1).Value = myFolderName & Fichier
'Effectue la copie des données
Rg.Copy Dest
'Fermeture du fichier ouvert, et ce, sans sauvegarder
Wk.Close False
'Ajoute 1 au compteur pour passer au fichier suivant...
Else
Err = 0
End If
'On passe au fichier suivant dans le répertoire
Fichier = Dir()
X = ""
Loop

'Les fichiers que tu as définis doit être dans le
'répertoire sélectionné ou dans l'un des sous-répertoires.
'Pour boucler dans tous les sous-répertoires du répertoire principal
For Each myFolder In myBaseFolder.SubFolders
'On appelle en boucle cette même procédure pour tester
'chacun des fichiers Excel des sous-répertoires
Call FoldersInFolder(myFolder.Path)
Next
End Sub
'-------------------------------------------------------------------------------
Function ChoixDossier()
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = ActiveWorkbook.Path & ""
.Show
If .SelectedItems.Count > 0 Then
ChoixDossier = .SelectedItems(1)
Else
ChoixDossier = ""
End If
End With
End Function
'-------------------------------------------------------------------------------




"MichD" a écrit dans le message de groupe de discussion : o7ap05$18m6$1@gioia.aioe.org...

Quand tu es sur le site cjoint.com, lorsque tu demandes "enregistrer le fichier sur ton
ordinateur", remarque dans le nom de la fenêtre l'extension du fichier .xlsx. Ce type de
fichier ne peut pas contenir de macro. Moi, mon fichier a une macro et tu dois modifier
manuellement l'extension du fichier .xlsx pour .xlsm et il va ouvrir normalement.

Voici le code contenu dans le module :

J'ai pris la peine de commenter presque toutes les lignes du code.

La macro inscrit le chemin le nom et le chemin du fichier en ligne 1
et copie la première colonne de la feuille 1 du classeur vers la feuille 1
du classeur où tu copieras cette procédure.

L'essentiel est là... selon la plage que tu as à copier, tu devras modifier légèrement la
macro.

Je crois que tu vas pouvoir t'en sortir avec un peu d'effort.


'Déclaration des variables dans le haut du module standard
Dim FSO As Object
Dim myBaseFolder As Object
Dim myFolder As Object
Dim F As Object
Dim Col As Long
'---------------------------------------------------------------------------------
Sub Compilation_Fichier_Excel()
Dim RépertoireSource As String

Application.ScreenUpdating = False
Application.EnableEvents = False

'********Définir les variables***********
'2 façons de faire, en inscrivant sois-même
'le chemin ou en laissant l'usager choisir.
'RépertoireSource = "C:UsersMichDDownloadsExcel"

'Si tu préfères laisser l'usager choisir le répertoire de départ
'Enlève l'apostrophe devant la ligne de code suivante
RépertoireSource = ChoixDossier
'****************************************
If RépertoireSource = "" Then
MsgBox "Comme vous n'avez pas retenu un répertoire, " & vrcl & Chr(13) & _
"l'opération est annulée.", vbInformation + vbOKOnly, "Attention."
End If

Set FSO = CreateObject("scripting.filesystemobject")

Col = 1
Call FoldersInFolder(RépertoireSource)

ThisWorkbook.Worksheets(1).UsedRange.EntireColumn.AutoFit
Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub
'---------------------------------------------------------------------------------
Sub FoldersInFolder(myFolderName As String)
Dim Fichier As String, Wk As Workbook
Set myBaseFolder = FSO.getfolder(myFolderName)

'Si le dernier caractère du répertoire myFolderName
'ne contient pas "", on doit l'ajouter
If Right(myFolderName, 1) <> "" Then
myFolderName = myFolderName & ""
End If

'premier fichier Excel du répertoire
Fichier = Dir(myFolderName & "*.xl*")

'Une boucle sur tous les fichiers Excel du répertoire
Do While Fichier <> ""
'Dans la ligne 1, on colle le chemin et le nom du fichier Excel
ThisWorkbook.Worksheets("Feuil1").Cells(1, Col) = myFolderName & Fichier
'On ouvre le fichier identifié
Set Wk = Workbooks.Open(myFolderName & Fichier)
'Avec la première feuille du fichier
'au lieu de l'index, on peut la nommer par son nom si tous
'les fichiers utilisent le même nom pour la feuille.
With Wk.Worksheets(1)
'Définis la plage à copier, soit la première colonne de chaque
'fichier. (Ceci c'était pour le besoin de l'exemple)
'Tu peux choisir la plage de ton choix
Set rg = .Range("A1:A" & .Range("A" & .Rows.Count).End(xlUp).Row)
'copie de la plage définie dans la première feuille
'ou tu as copié cette procédure
rg.Copy ThisWorkbook.Worksheets(1).Cells(2, Col)
'Fermeture du fichier ouvert et ce, sans sauvegarder
Wk.Close False
'Ajoute 1 au compteur pour passer à la colonne suivante...
Col = Col + 1
End With
'On passe au fichier suivant du répertoire
Fichier = Dir()
Loop

'Pour boucler dans tous les sous-répertoires du répertoire principal
For Each myFolder In myBaseFolder.SubFolders
'On appelle en boucle cette même procédure pour
'chacun des fichiers Excel des sous-répertoires
Call FoldersInFolder(myFolder.Path)
Next
End Sub
'---------------------------------------------------------------------------------
Function ChoixDossier()
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = ActiveWorkbook.Path & ""
.Show
If .SelectedItems.Count > 0 Then
ChoixDossier = .SelectedItems(1)
Else
ChoixDossier = ""
End If
End With
End Function
'---------------------------------------------------------------------------------







a écrit dans le message de groupe de discussion :
e17e1811-e72b-4e8e-88fa-8c9d25a296b1@googlegroups.com...

Bonsoir MichD,

Merci !
Je voulais tester mais le fichier ne fonctionne pas...corrompu...
Mais au vu de ton explication... je précise..
J'ai 3 fichiers de nom differents mais dont la structure est identique:
semaine1.xls
semaine2.xls
semaine3.xls

Je veux compiler les 3 fichiers mais que la colonne A reprenne le nom du fichier
semainex pour chaque ligne
cela est-il possible ?

Grand merci pour ton aide