Ouvrir des classeurs .xls + optimisation macro
Option Explicit
Sub Base2()
'===========VARIABALES================================================================
Dim list As Variant
Dim list2 As Variant
Dim CP As Variant
Dim x As Range
Dim ligne As Integer
Dim colonne As Integer
Dim Li As Integer
Dim Piece3 As Integer
Dim Piece2 As Integer
Dim Piece As Integer
Dim Item As Integer
Dim Nom1 As String
Dim A As String
Dim B As String
Dim C As String
Dim D As String
Dim E As String
Dim F As String
Dim F1 As String
Dim H As String
Dim I As String
Dim J As String
'++++++++++OPTIMISATION MACRO+++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Dim BoEcran As Boolean, Bobarre As Boolean, BoEvent As Boolean, BoSaut As Boolean, iCalcul As Integer 'LienMAJ As Boolean
BoEcran = Application.ScreenUpdating
Bobarre = Application.DisplayStatusBar 'barre d'etat
BoEvent = Application.EnableEvents
'BoSaut = ActiveSheet.DisplayPageBreaks
iCalcul = Application.Calculation
'LienMAJ = Application.AskToUpdateLinks
'''
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
'ActiveSheet.DisplayPageBreaks = False
Application.Calculation = xlManual
'Application.AskToUpdateLinks = False
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'===================Chemins d'accès======================================================
A = ".." 'je peux pas montrer les chemins
B=".."
C=".."
D=".."
E=".."
F=".."
F1=".."
H=".."
I J=".."
'================================================================================================
'''''''''''''''''''''formatage''''''''''''''''''''''''''''''''''''''''
Call SupprimerFeuille
Sheets(1).Activate
Range("A3:M20").Delete
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Li = 0 'offset
'=====================DEMANDE NUM ITEM + PLAGE PIECE=======================================
Item = Application.InputBox("Numéro de l'item", "item", Type:=2)
Piece = Application.InputBox("Entrez le numéro de la pièce de départ", "Pièce", Type:=2)
Piece2 = Application.InputBox("Entrez le numéro de la pièce de fin", "Pièce", Type:=2)
'==========================================================================================
Piece = Piece - 10
Piece2 = Piece2 - 9
Piece3 = Piece + 10
'================Boucle:ouvre fichier source, copie, colle dans le fichier récepteur....=====================
'============================================================================================================
While Piece <> Piece2
'""""""""""""""""""""""""""""Ouverture fichier source"""""""""""""""""""""""""""""""""""""""""""
list = Array(A, B, C, D, E, F, F1, H, I, J)
CP = list(Piece)
'On Error Resume Next
Workbooks.Open Filename:= _
CP, UpdateLinks:=0
'Application.Wait (Now + TimeValue("00:00:01"))
'""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
Nom1 = ActiveWorkbook.Name
Set x = Sheets(1).Columns(1).Cells.Find(Item, , xlValues, lookat:=xlWhole)
ligne = x.Row
colonne = x.Column
Sheets(1).Activate
Cells(ligne, colonne).Select ' selection des cellules à recupérer
Selection.Copy
Workbooks("BASE.xlsm").Activate
Range("B3").Offset(Li, 0).Select ' selection de la cellule où l'on souhaite mettre nos données
ActiveSheet.Paste
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Workbooks(Nom1).Sheets(1).Activate
Cells(ligne, colonne).Offset(0, 2).Select
Selection.Copy
Workbooks("BASE.xlsm").Activate
Range("C3").Select ' selection de la cellule où l'on souhaite mettre nos données
ActiveCell.Offset(Li, 0).Select
ActiveSheet.Paste
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Workbooks(Nom1).Sheets(1).Activate
' selection des cellules à recupérer
Cells(ligne, colonne).Offset(0, 3).Select
Selection.Copy
Workbooks("BASE.xlsm").Activate
' selection de la cellule où l'on souhaite mettre nos données
Range("D3").Offset(Li, 0).Select
ActiveSheet.Paste
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Workbooks(Nom1).Sheets(1).Activate
Range("Q1").Select
Selection.Copy
Windows("BASE.xlsm").Activate
Sheets(1).Range("E3").Offset(Li, 0).PasteSpecial xlPasteValuesAndNumberFormats
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Workbooks(Nom1).Sheets(1).Activate
Range("Q3").Select
Selection.Copy
Windows("BASE.xlsm").Activate
' selection de la cellule où l'on souhaite mettre nos données
Range("F3").Offset(Li, 0).Select
ActiveSheet.Paste
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Workbooks(Nom1).Sheets(1).Activate
' selection des cellules à recupérer
Cells(ligne, colonne).Offset(0, 6).Select
Selection.Copy
Workbooks("BASE.xlsm").Activate
' selection de la cellule où l'on souhaite mettre nos données
Range("G3").Offset(Li, 0).Select
ActiveSheet.Paste
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Workbooks(Nom1).Sheets(1).Activate
' selection des cellules à recupérer
Cells(ligne, colonne).Offset(0, 7).Select
Selection.Copy
Workbooks("BASE.xlsm").Activate
Sheets(1).Range("H3").Offset(Li, 0).PasteSpecial xlPasteValuesAndNumberFormats
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Workbooks(Nom1).Sheets(1).Activate
' selection des cellules à recupérer
Cells(ligne, colonne).Offset(0, 8).Select
Selection.Copy
Workbooks("BASE.xlsm").Activate
Sheets(1).Range("I3").Offset(Li, 0).PasteSpecial xlPasteValuesAndNumberFormats
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Workbooks(Nom1).Sheets(1).Activate
' selection des cellules à recupérer
Cells(ligne, colonne).Offset(0, 20).Select
Selection.Copy
Windows("BASE.xlsm").Activate
Sheets(1).Range("K3").Offset(Li, 0).PasteSpecial xlPasteValues
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Workbooks(Nom1).Sheets(1).Activate
' selection des cellules à recupérer
Cells(ligne, colonne).Offset(0, 21).Select
Selection.Copy
Workbooks("BASE.xlsm").Activate
Sheets(1).Range("L3").Offset(Li, 0).PasteSpecial xlPasteValues
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Workbooks(Nom1).Sheets(1).Activate
' selection des cellules à recupérer
Cells(ligne, colonne).Offset(0, 22).Select
Selection.Copy
Workbooks("BASE.xlsm").Activate
Sheets(1).Range("M3").Offset(Li, 0).PasteSpecial xlPasteValues
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Cells(3, 1).Offset(Li, 0).Select
Selection.Value = Piece3
Piece3 = Piece3 + 1
Li = Li + 1
Piece = Piece + 1
Workbooks(Nom1).Activate
ActiveWorkbook.Close
Wend
'============================================================================================
'============================================================================================
'Creation graphe
Call graphe
Application.ScreenUpdating = BoEcran
Application.DisplayStatusBar = Bobarre
Application.EnableEvents = BoEvent
'ActiveSheet.DisplayPageBreaks = BoSaut
Application.Calculation = iCalcul
'Application.AskToUpdateLinks = LienMAJ
End SubBonjour,
je suis actuellement entrain d'établir une macro permettant de récupérer des données dans + de 1000 fichier différents, je travaille actuellement avec seulement (5-10fichiers) sur réseau. Problème, mon fichier récepteur est de type xlsm et les fichiers sources sont de type xls.J'ai donc une erreur lors de l'exécution de la macro "1004 le format et l'extension ne correspondent pas.....Ne l'ouvrez pas, à moins que la source soit fiable....".Vais-je devoir convertir tout mes fichiers en format xlsm ou il y a une autre solution plus simple? Je tiens à dire que je suis débutant et que je me suis débrouillé jusque la avec les infos trouvées sur internet, si vous avez la solution pour mon souci et des conseilles pour optimiser mon code je suis preneur ! Merci :)
J'ai essayé de limiter les select etc.. mais bon j'ai atteins ma limite.
Bonjour,
peut-être essayer d'utiliser en début de code :
Application.DisplayAlerts = False Extrait aide Excel :
La valeur par défaut de la propriété Application.DisplayAlerts est True. Définissez cette propriété sur False pour supprimer les invites et les messages d'alerte pendant l'exécution d'une macro. Quand un message requiert une réponse, Microsoft Excel sélectionne la réponse par défaut.
A+
Bonjour à tous,
Pour la question de l'optimisation du code, voici une première proposition d'adaptation, sauvage :
Sub Base2()
'===================Chemins d'accès======================================================
'<<<<<<<<<<<<< SUREMENT BEAUCOUP PLUS SIMPLE !!!!!! NE MARCHERA PAS AVEC 1000 FICHIERS !
A = ".." 'je peux pas montrer les chemins
B = ".."
C = ".."
D = ".."
E = ".."
F = ".."
F1 = ".."
H = ".."
I = ".."
J = ".."
tpath = array(A, B, C, D, E, F, F1, H, I, J)
tcolsrc = array(0, 2, 3, 4, 5, 6, 7, 8, 20, 21, 22)
tcoldest = array(2, 3, 4, 5, 6, 7, 8, 9, 11, 12, 13)
item = inputbox("item")
'================================================================================================
'''''''''''''''''''''alimentation des données''''''''''''''''''''''''''''''''''''''''
redim tdata(ubound(tpath), ubound(tcolsrc))
for i = lbound(tpath) to ubound(tpath)
with Workbooks.Open(tpath(i), 0)
with .Sheets(1)
Set x = .Columns(1).Find(Item, , xlValues, xlWhole)
for j = lbound(tcolsrc) to ubound(tcolsrc)
tdata(i, j) = .Cells(x.row, x.column + tcolsrc(j))
next j
end with
.close true
end with
next i
'.............restitution des données............................................;;
with thisworkbook.sheets(1)
for i = lbound(tdata) to ubound(tdata)
for j = lbound(tdata, 2) to ubound(tdata, 2)
.cells(3 + i, tcoldest(j)).value = tdata(i, j)
next j
next i
end with
Call graphe
End SubJe ne suis pas sûr d'avoir bien compris donc j'ai adapté selon ce qui me paraissait logique. C'est-à-dire :
- on a maintenant un tableau avec l'ensemble des fichiers, un autre avec le décalage à effectuer dans les colonnes source, un autre avec les numéros de colonne de destination. Ca permet de boucler et d'éviter de répéter la même opération 12 fois ;
- fin de piece, piece2 et piece3 : on boucle sur l'ensemble des fichiers définis dans les variables qui rentrent ensuite dans le tableau tpath ;
- on enlève pour l'instant ces réglages d'application qui pourront éventuellement être repris plus tard si ce code donnait quelque chose. On utiliserait alors une macro secondaire (à appeler comme la macro graphe) pour éviter de polluer celle-ci déjà assez longue.
Sinon, je ne suis pas certain que l'inputbox soit la méthode la plus sûre pour définir les valeurs à importer...
Il faudra trouver une alternative pour les 1000 fichiers car définir les chemins en dur dans le code, ce n'est pas possible
Cdlt,
Merci pour vos réponses!!, "Application.DisplayAlerts = False" a fonctionné au début puis n'a plus fait effet bizarre..
Le code de 3GB est très concluant merci! mais il faudrait que je rajoute une demande voir 2 demandes , je m'explique à l'origine mon code demande un "item" soit un numéro d'une partie de pièce les 1000fichiers représentent la même pièce donc les items sont les mêmes. Le but est de comparer les côtes d'un item de différentes pièces que l'on peut choisir. Dans mon code d'origine je demande une pièce de départ(les pièces ont un numéro attribué qui est demandé ) et de fin pour déterminer une plage pour ma boucle, cela permet de comparer seulement les fichiers (ou pièces) demandé.Il faudrait que je rajoute cette demande mais aussi que l'utilisateur puisse rentrer le numéro des pièces qu'il veut voir(ex:pièces: 10,12,40,6) et pas être obligé de rentrer une plage (ex:de 10 à 15 pièces).Concernant les 1000fichiers je pense que je vais être obliger de rentrer tout les chemins.. :( mais c'est un problème minime !
Bonjour,
La question des pièces est la partie que j'ai moins comprise. Il faudrait que je comprenne bien pour adapter le code.
Non, vous ne pourrez pas rentrez 1000 chemins dans le code, ce n'est pas raisonnable. Il suffit d'un changement pour provoquer un bug...
Il est possible de boucler sur tous les fichiers d'un dossier et de ses sous-dossiers et il est possible d'appliquer des filtres...
Cdlt,
1fichier = 1pièce, les fichiers sources sont tous pareils. le but est de comparé différentes pièces pour 1 item rentrer par l'utilisateur.
Exemple: je veux voir comment se comporte l'item numéro 7 sur ma pièce 10,11,16,52. Je rentre le numéro 7 pour l'item et le numéro des pièces
ma macro va alors aller chercher mon item( et récupérer les cellules correspondante sur la ligne comme dans le code que tu as fais) dans ces 5 fichiers correspondant afin de coller les infos dans mon fichier récepteur , ou alors je veux voir mon item 7 sur 20pièces, je choisis donc ma pièce 10 de départ jusqu'à ma pièce 30 de fin.
Je pense pas pouvoir faire plus claire désolé :(
et sinon oui j'ai vu les filtres mais je sais pas trop les utiliser
Avec mes remerciements
Donc pour récapituler chaque fichier représente une pièce. Il y en a 1000 mais il faudrait que vous en sondiez tantôt 4, tantôt 20.
C'est assez peu courant comme problème donc je me dis que quelque chose ne va pas... Ces fichiers sont ils modifiés régulièrement ? Ne serait-il pas possible de récupérer toutes les infos de tous les fichiers une bonne fois pour toute afin de constituer une base sur le fichier exécutant, facilement consultable ?
Par ailleurs, j'ai une vague idée du temps d'exécution lorsqu'on manipule une trentaine de fichiers mais un millier, je n'en ai aucune.
Cdlt,
Non ils ne sont pas modifiées régulièrement mais avoir une telle base de données sur un classeur serait trop long et Excel le supporterait ?
votre macro m'a fait gagner beaucoup de temps d'exécution je vous en remercie et les fichiers s'ouvre correctement!, J'essaye maintenant de l'utiliser et d'y ajouter la partie sur la recherche de fichier j'ai d'ailleurs lancé un nouveau forum à ce sujet https://forum.excel-pratique.com/excel/rentrer-le-chemin-de-plusieurs-fichiers-dans-des-variables-au...
je pensais en dernier recours mettre tout les chemins dans un fichiers texte...
Bonjour Dignis,
Je ne sais pas combien de lignes il peut y avoir par fichier mais je pense qu'Excel supporterait une telle base...
Selon moi, en général, il est plus simple de regarder régulièrement dans un tableau que d'importer des données d'autres fichiers.
Bonne continuation pour la suite en tout cas !
Cdlt,