aller chercher des données avec une boucle

[bari64]

bonjour à tous je suis nouveau sur ce forum

en fait je suis en alternance dans une entreprise de production. Et une de mes premieres missiosn est d'effectuer une macro pour avoir un rapport de production sur une période demandée à l'utilisateur. Pb: je ne connais pas vba :s

cela fait 2 semaines que je cherche des info dans les forums mais je m'en sort pas vraiment. donc je me tourne aussi vers vous pour que vous m'aidiez si c'est possible.

Dans un dossier en l'occurence "E:\DATAS\3 - production\rapport exploitation\rapports journaliers de production\2009" se trouve des rapports de production ( donc classeurs) de chaque semaine de l'année ( appelé par exemple semaine_33) et dans ces classeurs se trouvent 6 onglets avec la date de chaque jour de cette semaine, soit 5 jours et un résumé de la semaine en dernier ( nommé de la sorte : 10_07_08, etc )

dans mon rapport (fichier nommé date) je devrais faire un bouton capable de demander à l'utilisateur la date de début et de fin entre lesquelles il veut voir les résultats. donc aller chercher les données automatiquement dans tous ces classeurs (et donc les onglets)

j'ai commencé à faire quelque chose notamment pour la boucle car je pense que c'est le coeur du programme mais je ne m'en sort, je devien fou.

Voici ce que j'ai commencé

Sub macro1()
 
Dim Ddeb As Date, Dfin As Date
Dim a As Integer
Dim Ws, X As Workbook
Dim Dcours As Long
Dim nomc As String, repertoire As String
Dim Nbjour As String
 
 
 
' c'est la ou se trouve mes classeurs je pense qu'on peut faire mieux dans mon code après grace a ca, mais je sais pas comment l'utiliser '
nomc = "E:\DATAS\3 - production\rapport exploitation\rapports journaliers de production\2009"
repertoire = Dir(nomc & "*xls*", vbDirectory)
 
' je calcule le nbre de jour entre date de début et date de fin '
Nbjour = DateDiff("s", Ddeb, Dfin)
 
 
 
 
' il me manque la fonction pour déterminer la semaine que l'on veut ouvrir en fonction de la date de début'
SemaineEnCours = DatePart("Ddeb", TaDate, vbMonday, vbFirstJan1)
 
 
 
For i = 0 To Nbjour
' ouverture du classeur correspondant à la semaine de la Ddeb"
Ws = Worksbooks.Open(Filename:="E:\DATAS\3 - production\rapport exploitation\rapports journaliers de production\2009" & semaineEnCours & "*xls*")
 
 
'activation de la feuille de la Ddeb"
Sheets("Ddeb").Activate
 
 
' on copie les valeurs des cellules de C5 à C39 et on les colle dans la colonne de F5 à F 35 du rapport qu'on est entrain de créer.'
Set plage = Sheets(Ddeb).Range(Cells(5, 3), Cells(39, 3))
plage.Copy
Worksbooks("date.xlsm").Cells(5, 7).PasteSpecial
 
 
'On copie de meme les valeurs de C5 à C39 de la Ddeb +1 (onglet + 1 du même classeur) qu'on colle dans G5 à G39 du rapport en création date.xlsm( comment aligne t'on les données copier??) .'
'faut il l'activer avant?'
Dcours = Deb + 1
Set plage = Sheets(Dcours).Range(Cells(5, 3), Cells(39, 3))
plage.Copy
 
 
 
'On fait ceci jusqu'a la fin de la semaine'
 
 
 
ActiveWorkbook.Close savechanges:=False 'on ferme le classeur de la semaine ouverte'
 
 
X = Worksbooks.Open(Filename:="E:\DATAS\3 - production\rapport exploitation\rapports journaliers de production\2009" & f + 1 & "*xls*")
'On ouvre le classeur de la semaine en cours + 1'
 
 
'et on refait la même chose jusqu'a la fin de la semaine ( copie des cases C 5 à C 39 des 5 premiers onglets de la semaine qu'on colle sur le nouveau rapport en alignant aux autres données (voir fichier rapport nommé date.xlsm)) '
 
 
' On continue la boucle jusqu'a que la date de fin rentrée par l'utilisateur correspond à la date de l'onglet.'
 
Next i

donc voila je viens vers vous afin d'avoir une aide j'espère précieuse et si je suis parti dans une mauvaise direction vous pouvez me le dire aussi et me remettre sur les rails je vous y autorise .


Merci bien

 

[bari64]

Re : aller chercher des données avec une boucle

Je ne sais pas si j'ai été clair mais pouvez vous me guider un minimum s'il vous plait...

Merci

 

[kjin]

Re : aller chercher des données avec une boucle

Bonjour,
Un fichier semaine_x aurait était bienvenu, ça m'aurait évité de le créer, si tant est qu'il soit conforme

...Dans un dossier en l'occurence "E:\DATAS\3 - production\rapport exploitation\rapports journaliers de production\2009" se trouve des rapports de production donc classeurs de chaque semaine de l'année -nommés- semaine_33) et dans ces classeurs se trouvent 6 onglets avec la date de chaque jour de cette semaine, soit 5 jours -nommés - 10_07_08...

Sur ces indications, sans ouvrir les fichiers avec une requête ADO
Testé sous 2000, donc 2007 ?

Option Explicit

Sub ImportADO()
'Nécessite d'activer Microsoft ActiveX Data Objects x.x Librairy
Dim x As String, y As String, rep As String, c As Byte, i As Long, semA As Byte
Dim fichier As String, feuille As String
Dim Cn As ADODB.Connection, Rst As ADODB.Recordset, strReq As String
x = Application.InputBox("Date début ? (jj/mm/aa)", Type:=2)
If Not IsDate(x) Then Exit Sub
y = Application.InputBox("Date fin ? (jj/mm/aa)", Type:=2)
If Not IsDate(y) Then Exit Sub
rep = "E:\DATAS\3 - production\rapport exploitation\rapports journaliers de production\2009" 'répertoire des fichiers
c = 6 'N° de la première colonne à saisir
For i = CDbl(CDate(x)) To CDbl(CDate(y)) 'boucle sur tous les jours de l'interval[x,y]
    If Weekday(CDate(i)) <> 1 And Weekday(CDate(i)) <> 7 Then 'si jour <> samedi et dimanche
        semA = DatePart("ww", CDate(i)) 'N° semaine du jour
        fichier = rep & "semaine_" & semA & ".xls" 'chemin du fichier
        feuille = Format(CDate(i), "dd_mm_yy") 'nom de la feuille
        On Error Resume Next 'on pourrais utiliser ADOX à la place
        Set Cn = New ADODB.Connection 'connexion
            With Cn
                .Provider = "Microsoft.Jet.OLEDB.4.0"
                .ConnectionString = "Data Source=" & fichier & _
                            ";Extended Properties=""Excel 8.0;HDR=NO"""
                .Open
            End With
            strReq = "SELECT * FROM [" & feuille & "$C9:C35]"
            Set Rst = New ADODB.Recordset
            Set Rst = Cn.Execute(strReq)
            Cells(5, c) = CDate(i) 'transfert la date
            Range(Cells(9, c), Cells(35, c)).CopyFromRecordset Rst 'transfert des valeurs
            Rst.Close
            Cn.Close
            Set Cn = Nothing
            Set Rst = Nothing
            c = c + 1
    End If
Next

End Sub

A+
kjin