Fichier de synthése

Version imprimable

22/07/2011, 09h30
dalaae

Fichier de synthése

Bonjour le Forum,

Je viens vers vous car j'essai de mettre en place un fichier de synthsé de plusiseurs centaines de classeurs excel.. chaque classeur contenant plusieurs feuilles de même type.

Mon traitement étant de faire un test sur les checkbox des différentes feuilles des classeurs fermés et venir renseinger des champs dans le classeur synthése.

J'hésite à utiliser une connexion ADO.. ou à rester avec laMacro4 de excel..! Le bemole de la deuxiéme solution est que je trouve pas de moyen de parcourir les feuilles d'un fichiers fermé. Si vous pouvez me donner des idées ça serait trop cool.

Merci d'avance!
22/07/2011, 09h49
Daranc

consultes ceci
http://silkyroad.developpez.com/VBA/ClasseursFermes/

Merci pour le lien, je l'ai déja consulter..! je me suis bien inspiré pour mettre en place une procédure... qui ne marche pas..! si tu peux bien me debeuguer!

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
 
Sub Requete2007(fichier As String, NomFeuille As String, cel As String)
    Dim Cn As ADODB.Connection
    Dim texte_SQL As String
    Dim Rst As ADODB.Recordset
    Dim ADOCommand As ADODB.Command
 
    Set Cn = New ADODB.Connection
 
    '--- Connexion ---
    Cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
           & fichier & ";Extended Properties=""Excel 12.0;HDR=YES;"""
'        .Provider = "Microsoft.Jet.OLEDB.4.0"
'        .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
'            & fichier & ";Extended Properties=""Excel 12.0;HDR=YES;"""
'        .Open
'    End With
    '-----------------
 
    ' la requête ...
    Set ADOCommand = New ADODB.Command
    With ADOCommand
        .ActiveConnection = Cn
        .CommandText = "SELECT * FROM [" & NomFeuille & cel & "]"
    End With
 
    Set Rst = New ADODB.Recordset
    Rst.Open ADOCommand, , adOpenKeyset, adLockOptimistic
 
    Set Rst = Cn.Execute("[" & NomFeuille & cel & "]")
 
    Cells(2, 1).CopyFromRecordset Rst
    MsgBox (Cells(2, 1).Value)
 
    '--- Fermeture connexion ---
    Cn.Close
    Set Cn = Nothing
 
End Sub

22/07/2011, 10h16
Daranc

quel est le message d'erreur ?
quelle est la ligne pointée par le débogueur
22/07/2011, 10h17
dalaae

Il n'y a pas de message d'erreur, l'execution se déroule bien.. mais aucun réusltat à la fin.. c'est ce qui m'intrigue!
22/07/2011, 10h28
Daranc

je connais pas trop le principe de ces manips mais il y a un message /!\ de SilkyRoad qui dit de ne pas oublier le "$" derrier la feuille
22/07/2011, 10h39
dalaae

J'ai bien fait attention à ce message là..! Je ne comprend pas non plus pk ça ne marche pas..! Merci quand même.
Mais si jamais t'a une autre idée pour parcourir les feuilles d'un classeurs fermé je suis preneur..!
Actuellement j'utilise la methode getobject..mais elle ouvre le classeur en question en background.. :s

je regarde si il y a une autre méthode avec les code d'Excel

bon j'ai trouvé ce truc qui va balayer le répertoire ciblé et prendre en tableau les valeurs situe dans une cellule ( toujours la même dans ce cas ) sans ouvrir le fichier il ne s'agit que de lecture , pas d'écriture

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
 Sub parcours()
Application.DisplayAlerts = False
Dim fs, f, f1, fc, u
Dim tablo() As Variant
Dim tablo2() As Variant
u = 1
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder("C:\Boeuf\david excel\Excel")
Set fc = f.Files
For Each f1 In fc
If UCase(Right(f1.Name, 4)) = ".XLS" Then
ReDim Preserve tablo(1 To u)
tablo(u) = f1.Name
u = u + 1
Else
End If
Next
u = 1
For t = 1 To UBound(tablo, 1)
ReDim Preserve tablo2(1 To 2, 1 To t)
tablo2(1, t) = tablo(t)
tablo2(2, t) = f & "\" & tablo(t) & Cells(5, 6).Value
Next
Erase tablo
' pour poser le tableau ailleurs
'ne pas oublier le  classeurplage=application.worksheetfunction.transpose( tablo2)
End Sub

22/07/2011, 11h41
dalaae

D'accord.. Merci en tout cas pour tes réponses ;)!

J'ai jettez un coup d'oeil sur ta procedure.. elle balaye bien les fichiers du repertoire.. mais elle ne balaye pas les feuilles de chaque fichier.. et c'est là ou je beug.. !
je voudrais trouver un moyen de parcourir les feuilles de chaques fichiers sans l'ouvrir!
J'ai essayé d'utiliser la méthode getobject.. mais helas elle ouvre le fichier en background.. et comme j'ai un centaine de fichier à traiter.. chacun avec une centaine de feuilles.. ça me fait beuguer l'application!
22/07/2011, 14h26
Daranc

oui il faut prolonger la macro par une boucle sur les feuilles du
genre

Code:

for sh= 1 to sheets.count

à integré dans les boucles existantes
22/07/2011, 14h29
dalaae

c'est quoi le type de sh.. ? à quelle collection appartient-elle? surtout que je travail avec des fichiers fermé.. :s! d'ou la source du probleme!

bon en regardant le truc j'ai trouvé une fonction de J.Boigondier
ça donne ceci

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
Function NbFeuillesClasseurFermé(chemin)
Dim Conn, Cat, Tbl
Dim Connex$
Connex = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & chemin & ";" & _
"Extended Properties=Excel 8.0;"
Set Conn = CreateObject("ADODB.Connection")
Conn.Open Connex
Set Cat = CreateObject("ADOX.Catalog")
Set Cat.ActiveConnection = Conn
For Each Tbl In Cat.Tables
If InStr(1, Tbl.Name, "$") > 0 Then Nb = Nb + 1
Next
NbFeuillesClasseurFermé = Nb
Conn.Close
Set Cat = Nothing
Set Conn = Nothing
End Function
Sub parcours()
Application.DisplayAlerts = False
Dim fs, f, f1, fc, u
Dim tablo() As Variant
Dim tablo2() As Variant
u = 1
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder("C:\Boeuf\david excel\Excel")
Set fc = f.Files
For Each f1 In fc
If UCase(Right(f1.Name, 4)) = ".XLS" Then
ReDim Preserve tablo(1 To u)
tablo(u) = f1.Name
u = u + 1
Else
End If
Next
u = 1
For t = 1 To UBound(tablo, 1)
ReDim Preserve tablo2(1 To t)
tablo2(t) = f & "\" & tablo(t)  ' & Cells(5, 6).Value
Next
Erase tablo
u = 1
For t = 1 To UBound(tablo2, 1)
chemin = tablo2(t)
 
For sh = 1 To NbFeuillesClasseurFermé(chemin)
ReDim Preserve tablo(1 To u)
tablo(u) = tablo2(t) & "sheets(" & sh & ")"
u = u + 1
Next
Next

pour sh c'est sous 2003 en byte (sauf si tu chopes la feuille 256) autrement pour 2007 il va falloir la mettre en interger

Merci bcp pour le code.. je vais essayer de le tester et l'adapter pr 2007..! je te dirais ce que ça donne..!

Entre temps bon week end.. et merci encore pour le coup de main.

je reviens vers toi.. j'ai mis en place la procédure suivante.. qui a l'air de bien marché.. cependant je ne comprend pas pq elle ne me renvoie pas les cellules que j'ai demandé..!

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
 
Private Sub etablirConnexion(NomDirSource As String)
 
 
    Dim FSO As Scripting.FileSystemObject
    Dim DirSource As Scripting.Folder
 
    Set FSO = New Scripting.FileSystemObject
    Set DirSource = FSO.GetFolder(NomDirSource)
 
    Dim fichier As Scripting.file
 
    Dim Resultat As String
 
    Dim feuille As Object
    Dim XlConnect As Object
    Dim XlCatalog As Object
    Dim Rst As ADODB.Recordset
    Dim ADOCommand As ADODB.Command
 
 
    For Each fichier In DirSource.Files
        If Right(fichier.Name, 5) = ".xlsx" Then
 
                Set XlConnect = New ADODB.Connection
                Set XlCatalog = New ADOX.Catalog
 
                 With XlConnect
                    .Provider = "Microsoft.Jet.OLEDB.4.0"
                    .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
                    & ThisWorkbook.Path & "\" & fichier.Name & ";Extended Properties=""Excel 12.0;HDR=YES;"""
                    .Open
                End With
 
 
                Set XlCatalog.ActiveConnection = XlConnect
 
                For Each feuille In XlCatalog.Tables
                    If Right(feuille.Name, 1) = "$" Then
 
                        MsgBox (feuille.Cells(2, 2).Value)
 
                        Resultat = Application.WorksheetFunction.Substitute(feuille.Name, "$", "")
                        Resultat = Application.WorksheetFunction.Substitute(Resultat, "'", "")
                        MsgBox (Resultat)
 
                     Set ADOCommand = New ADODB.Command
                     With ADOCommand
                            .ActiveConnection = XlConnect
                            .CommandText = "SELECT * FROM [" & Resultat & "$" & "A7:A7" & "]"
                     End With
 
                    Set Rst = New ADODB.Recordset
                    Rst.Open ADOCommand, , adOpenKeyset, adLockOptimistic
 
                    Set Rst = XlConnect.Execute("[" & Resultat & "$" & "A7:A7" & "]")
 
                    Range("B4").CopyFromRecordset Rst
 
End Sub

elle parcours bien le dossier.. recupére les noms des feuilles.. mais ne me renvoie pas la valeur de la cellule que j'ai demandé.. !s Si tu arrives à voir ou je fais une erreur..!