PROGRAMME SUR LA GESTION ET LE TRAITEMENTS DE FICHIERS
Tonin39
Messages postés75Date d'inscriptionmercredi 6 avril 2005StatutMembreDernière intervention 2 avril 2006
-
9 avril 2005 à 12:10
galopin01
Messages postés133Date d'inscriptionlundi 4 octobre 2004StatutMembreDernière intervention14 octobre 2011
-
9 avril 2005 à 22:13
Je suis actuellement en stage dans l'acoustique et je dois réaliser un ptit pgr avec VBA escel:
le sonometre stocke les mesures puis on les converti ensuite en fichiers .xls dans le dossier D:\DataCesva
le but est de lister les fichiers de les ouvrir un par un et de les mettre ds un tableau de facon ordonnéé
le pb que l'on a est ke le sonometre crée des fichiers excel de ce type:
il faut donc ouvrir chaque fichiers et prendre une colonne sur deux puis mettre les données les une derrière les autres puis les coller ds la feuille DATA
voici le pgr de liste:
Sub Recherche()
Worksheets("recupfichiers").Range("A1:A100").Clear
'efface les emplacement des fichiers que l'on veut lister
Worksheets("DATA").Range("C2:C100,D2:D100,E2:E100,F2:F100,G2:G100,H2:H100,I2:I100,J2:J100,K2:K100,L2:L100,M2:M100,N2:N100,O2:O100,P2:P100,Q2:Q100,R2:R100,S2:S100,T2:T100,U2:U100,V2:V100,W2:W100").Clear
'efface le tableau ou l'on veut mettre les données ordonnées
With Application.FileSearch
'D 'abord réinitialiser les critères (Attention : Le LookIn ne se réinitialise pas comme ça)
.NewSearch
'Pour mettre à jour la liste des dossiers, au cas ou on viendrait de créer un nouveau dossier par VBA :
.RefreshScopes
'Dossier(s) de recherche :
.LookIn = "D:\CesvaData"
'Fichiers à rechercher (J'ai essayé plusieurs formes "a*.php;C*.*" mais ça ne marche pas:
'.FileName = "*.*" recherche tous les fichiers
'.FileName = "C.php" recherche tous les fichiers qui contiennent c ou C quelque par dans leur nom, et qui se terminent par .php ou .PHP
.Filename = ".xls"
'Le type de fichiers qu'on recherche. Ici, tous, et de toute façon, on a déjà filtré avec .FileName. Mais on peut par exemple indiquer msoFileTypeExcelWorkbooks qui va extraire tous les fichiers Excelé (XLA, XLT, XLS, XLW)
.FileType = msoFileTypeAllFiles
'Tous les fichiers créés ou modifiés cette semaine :
.LastModified = msoLastModifiedThisWeek
'On va rechercher dans les sous dossiers d'atelier et Toto :
.SearchSubFolders = True
'C 'est parti :
.Execute
'Une boucle traditionnelle pour parcourir les fichiers trouvés. FoundFiles(Ctr) n'a pas de propriétés. Par exemple, pas question d'avoir le nom du fichier sans le dossier, ou même sa date de création (en tout cas par la méthode FoundFiles)
For ctr = 1 To .FoundFiles.Count
Worksheets("recupfichiers").Cells(ctr, 1) = .FoundFiles(ctr)
Worksheets("recupfichiers").Cells(ctr, 1).Select
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
Next
End With
End Sub
voila ceci marche avec le bouton de commande
Private Sub CommandButton1_Click()
Recherche
End Sub
QUES1
marche mais j'aimerais savoir si vous me suggérer des améliorations
deuxieme partie du pgr l'ouverture de tt les fichiers présents et le traitement
dc on ouvre un fichier a la fois et on copie une ligne sur 2, on met a la bonne police et on ordonne puis on colle ds DATA du classeur Fichescesva
pour faire les calcule je passe par une feuille intermédiaire "inter" ds le classeur Fichescesva
QUES 2
comment cacher la feuille pour ne pa voir les opérations éffectuées, ou sinon autre solution
voici mon pgr:
jai fait une boucle pour lire tt les fichiers présents (trouvé ac le pgr du haut)
Sub ouvrirfichier()
Dim z As Double
For z = 1 To 100
Cells(z, 1).Select
' si valeur alors faire tt le traitement
If Cells(z, 1).Value <> "" Then
Dim i As Double
Dim rec As String
'va chercher la source du fichier lister avec le pgr d'avt
Workbooks.Open Filename:=Worksheets("recupfichiers").Cells(z, 1).Value
rec = ActiveWorkbook.Name
'boucle qui copie les données une fois sur 2 puis les colle ds "inter"
For ctr = 11 To 51 Step 2
Windows(rec).Activate
i = (ctr - 8)
Cells(7, ctr).Select
Selection.Copy
Windows("FichesCesva.xls").Activate
Sheets("inter").Select
Cells(2, i).Select
ActiveSheet.Paste
Next ctr
Workbooks(rec).Close
'ensuite on ordonne les données, plus bonne police ds "inter"
Windows("FichesCesva.xls").Activate
Sheets("inter").Select
Range("C2,E2,G2,I2,K2,M2,O2,Q2,S2,U2,W2,Y2,AA2,AC2,AE2,AG2,AI2,AK2,AM2,AO2,AQ2").Select
Selection.Copy
Range("C4").Select
ActiveSheet.Paste
Range("C4:W4").Select
With Selection.Font
.Name = "Tahoma"
.Size = 5.5
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
' on copie le traitement
Dim col As Double
col = z + 1
Selection.Copy
' on colle les données ds la feuille DATA
Sheets("DATA").Select
Cells(col, 3).Select
ActiveSheet.Paste
End If
Next
End Sub
QUES3
la boucle marche mai ne copie ke le premier fichier après au deuxieme tour elle passe directe a la fin de la boucle, dc jaimerais savoir ou et le pb, sinon dites moi si ya des trucs tordus ok et cke jpeu améliorer
voila jai un peu de l ac le VBA donc pourriez vous répondre assez rapidement svp, parce ke fo kfinisse cette partie dmon stage
merci davance
A voir également:
PROGRAMME SUR LA GESTION ET LE TRAITEMENTS DE FICHIERS
galopin01
Messages postés133Date d'inscriptionlundi 4 octobre 2004StatutMembreDernière intervention14 octobre 20111 9 avril 2005 à 21:59
bonsoir,
ci-joint une ébauche, évidement je n'ai pas pu tester mais la philosophie générale y est...
Sub Recherche()
Application.ScreenUpdating = False '************ masque et accélère le traitement
Worksheets("recupfichiers").Range("A1:A100").Clear
'efface les emplacement des fichiers que l'on veut lister
Worksheets("DATA").Range("C2:W100").Clear '************
'efface le tableau ou l'on veut mettre les données ordonnées
With Application.FileSearch
'D'abord réinitialiser les critères (Attention : Le LookIn ne se réinitialise pas comme ça)
.NewSearch
'Pour mettre à jour la liste des dossiers,
'au cas ou on viendrait de créer un nouveau dossier par VBA :
.RefreshScopes
'Dossier(s) de recherche :
.LookIn = "D:\CesvaData"
'Fichiers à rechercher (J'ai essayé plusieurs formes "a*.php;C*.*" mais ça ne marche pas:
'.FileName = "*.*" recherche tous les fichiers
'.FileName = "C.php" recherche tous les fichiers qui contiennent c ou C quelque par dans
'leur nom, et qui se terminent par .php ou .PHP
.Filename = ".xls"
'Le type de fichiers qu'on recherche. Ici, tous, et de toute façon,
'on a déjà filtré avec .FileName. Mais on peut par exemple indiquer msoFileTypeExcelWorkbooks
'qui va extraire tous les fichiers Excelé (XLA, XLT, XLS, XLW)
.FileType = msoFileTypeAllFiles
'Tous les fichiers créés ou modifiés cette semaine :
.LastModified = msoLastModifiedThisWeek
'On va rechercher dans les sous dossiers d'atelier et Toto :
.SearchSubFolders = True
'C 'est parti :
.Execute
'Une boucle traditionnelle pour parcourir les fichiers trouvés. FoundFiles(Ctr)
'n'a pas de propriétés. Par exemple, pas question d'avoir le nom du fichier
'sans le dossier, ou même sa date de création (en tout cas par la méthode FoundFiles)
For ctr = 1 To .FoundFiles.Count
Worksheets("recupfichiers").Cells(ctr, 1) = .FoundFiles(ctr)
Worksheets("recupfichiers").Cells(ctr, 1).Select
Encadre '************ juste pour la lisibilité du prg
Next
End With
End Sub
Sub Encadre()
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
End Sub
Private Sub CommandButton1_Click()
Recherche
End Sub
Sub ouvrirfichier()
'D'abord les déclarations pas au milieu de la boucle !
Dim i%, z%, col%, rec$, multi$
'Dim ... As Double : Integer suffira bien !
multi = "C2,E2,G2,I2,K2,M2,O2,Q2,S2,U2,W2,Y2,AA2,AC2,AE2,AG2,AI2,AK2,AM2,AO2,AQ2"
Application.ScreenUpdating = False '************
For z = 1 To 100
'************ Ce qui explique que ta boucle ne travaillait qu'une fois !
Worksheets("recupfichiers").Activate'rec Worksheets("recupfichiers").Cells(z, 1).Value '************
'Cells(z, 1).Select '************
' si valeur alors faire tt le traitement
If rec <> "" Then
'va chercher la source du fichier lister avec le pgr d'avt
Workbooks.Open Filename:=rec '************
'rec = ActiveWorkbook.Name '************
'boucle qui copie les données une fois sur 2 puis les colle ds "inter"
For ctr = 11 To 51 Step 2 '********* après .Open rec est le classeur actif
'Windows(rec).Activate '************
i = (ctr - 8) '************
'******* Copie et colle directement au bon emplacement sans déplacer la sélection
Cells(7, ctr).Copy Workbooks("FichesCesva.xls").Sheets("inter").Cells(2, i)
Next ctr
Workbooks(rec).Close
'ensuite on ordonne les données, plus bonne police ds "inter"
Workbooks("FichesCesva.xls").Sheets("inter").Activate
'******* Copie et colle directement au bon emplacement sans déplacer la sélection
Range(multi).Copy Range("C4")
Range("C4:W4").Select
With Selection.Font
.Name = "Tahoma"
.Size = 5.5
End With
' on copie le traitement
col = z + 1
Selection.Copy Sheets("DATA").Cells(col, 3)
' on colle les données ds la feuille DATA SANS l'activer
End If
Next
End Sub
galopin01
Messages postés133Date d'inscriptionlundi 4 octobre 2004StatutMembreDernière intervention14 octobre 20111 9 avril 2005 à 22:10
Nota : dans mon exemple...
Worksheets("recupfichiers").Activate
n 'est pas nécessaire pour lire correctement le rec = ... qui suit.
par contre dans ton ébauche il est clair qu'à la fin de la première boucle ton
Cells(z, 1).Select... pointait sur "DATA.XLS"
A+