Sujet Précédent Sujet Suivant

Pgr

Tonin39 Messages postés 75 Date d'inscription mercredi 6 avril 2005 Statut Membre Dernière intervention 2 avril 2006 - 8 avril 2005 à 15:42
econs Messages postés 4030 Date d'inscription mardi 13 mai 2003 Statut Membre Dernière intervention 23 décembre 2008 - 8 avril 2005 à 20:49
voila je débute avec VBA et je programme mais em bidoullant
voici mon pgr :

Sub Recherche()
Worksheets("recupfichiers").Range("A1:A100").Clear
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
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


celui ci liste les fichiers ki se trouve ds datacesva

ensuite jai fait celui ci pour les ouvrir un par un et fr les traitements que jveu
voici le pgr:
Sub ouvrirfichier()
Dim Z As Double


For Z = 1 To 50
Cells(Z, 1).Select
If Range("A" & Z).Value <> "" Then
Dim i As Double
Dim rec As String
Workbooks.Open Filename:=Worksheets("recupfichiers").Cells(Z, 1).Value
rec = ActiveWorkbook.Name


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



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
Selection.Copy
Sheets("DATA").Select
Range("C2").Select
ActiveSheet.Paste


End If
Next
End Sub





merci de maider pqrce ke jgalère si vous voulez plus dimfo ben dite moi ok
merci c qssez urgent dc si vous pouviez rep
ciao

2 réponses

Réponse 1 / 2
cs_Jack Messages postés 14006 Date d'inscription samedi 29 décembre 2001 Statut Modérateur Dernière intervention 28 août 2015 79
8 avril 2005 à 18:17
... et quelle est la question, le problème ?

Vala
Jack, MVP VB
NB : Je ne répondrai pas aux messages privés

Le savoir est la seule matière qui s'accroit quand on la partage. (Socrate)
0
Réponse 2 / 2
econs Messages postés 4030 Date d'inscription mardi 13 mai 2003 Statut Membre Dernière intervention 23 décembre 2008 24
8 avril 2005 à 20:49
Bah oui .. .Pas de question, donc pas de réponse.



Par contre, j'ai vu un p'tit truc que tu peux visiblement améliorer :


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



peut s'écrire aussi comme ceci :




Worksheets("DATA").Range("C2:W100").Clear





Manu
-------------------------------------------
Une question bien posée, c'est une chance de réponse bien adaptée.
0
Rejoignez-nous