Macro excel
Gervaisb
Messages postés
5
Date d'inscription
samedi 10 décembre 2005
Statut
Membre
Dernière intervention
27 février 2006
-
12 févr. 2006 à 04:28
Gervaisb Messages postés 5 Date d'inscription samedi 10 décembre 2005 Statut Membre Dernière intervention 27 février 2006 - 13 févr. 2006 à 03:08
Gervaisb Messages postés 5 Date d'inscription samedi 10 décembre 2005 Statut Membre Dernière intervention 27 février 2006 - 13 févr. 2006 à 03:08
2 réponses
michelxld
Messages postés
402
Date d'inscription
vendredi 6 août 2004
Statut
Membre
Dernière intervention
12 octobre 2008
31
12 févr. 2006 à 08:37
12 févr. 2006 à 08:37
bonjour
j'espere que cet exemple pourra t'aider . la macro boucle sur tous les classeurs du repertoire et additionne la valeur de la cellule D33 ,dans chaque feuille "bon de commande" .
Option Explicit
Option Base 1
Sub extractrionValeurCelluleClasseursFermesV03()
'Necessite d'activer la reference Microsoft ActiveX Data Object 2.x Library
'
Dim Source As ADODB.Connection
Dim Rst As ADODB.Recordset
Dim ADOCommand As ADODB.Command
Dim Fichier As String, Direction As String, Cellule As String, Feuille As String
Dim X As Integer, NbFichiers As Integer
Dim Tableau() As String
Dim Resultat As Single
'boucle sur pour lister tous les classeur du repertoire cible
'pour cet exemple ,le classeur contenant la macro et les classeurs fermés
'sont dans le meme repertoire .
Direction = Dir(ThisWorkbook.Path & "\*.xls")
Do While Len(Direction) > 0
NbFichiers = NbFichiers + 1
ReDim Preserve Tableau(1 To NbFichiers)
Tableau(NbFichiers) = Direction
Direction = Dir()
Loop
Cellule = "D33:D33" 'adresse de la cellule contenant les valeurs à recuperer
Feuille = "bon de commande$" 'n'oubliez pas d'ajouter $
If NbFichiers > 0 Then
For X = 1 To NbFichiers 'boucle sur les classeurs
' pour ne pas prendre en compte le classeur contenant la macro(synthese)
If Tableau(X) <> ThisWorkbook.Name Then
Fichier = ThisWorkbook.Path & "" & Tableau(X)
Set Source = New ADODB.Connection
Source.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Fichier & ";Extended Properties=""Excel 8.0;HDR=No;"";"
Set ADOCommand = New ADODB.Command
With ADOCommand
.ActiveConnection = Source
'les données sont dans la "Feuil1" des classeurs fermés
.CommandText = "SELECT * FROM `" & Feuille & Cellule & "`"
End With
Set Rst = New ADODB.Recordset
Rst.Open ADOCommand, , adOpenKeyset, adLockOptimistic
Set Rst = Source.Execute("`" & Feuille & Cellule & "`")
Resultat = Resultat + Rst.Fields(0).Value
Rst.Close
Source.Close
Set Source = Nothing
Set Rst = Nothing
Set ADOCommand = Nothing
End If
Next X
End If
MsgBox "Total commandes :" & Resultat
End Sub
bon week end
michel
j'espere que cet exemple pourra t'aider . la macro boucle sur tous les classeurs du repertoire et additionne la valeur de la cellule D33 ,dans chaque feuille "bon de commande" .
Option Explicit
Option Base 1
Sub extractrionValeurCelluleClasseursFermesV03()
'Necessite d'activer la reference Microsoft ActiveX Data Object 2.x Library
'
Dim Source As ADODB.Connection
Dim Rst As ADODB.Recordset
Dim ADOCommand As ADODB.Command
Dim Fichier As String, Direction As String, Cellule As String, Feuille As String
Dim X As Integer, NbFichiers As Integer
Dim Tableau() As String
Dim Resultat As Single
'boucle sur pour lister tous les classeur du repertoire cible
'pour cet exemple ,le classeur contenant la macro et les classeurs fermés
'sont dans le meme repertoire .
Direction = Dir(ThisWorkbook.Path & "\*.xls")
Do While Len(Direction) > 0
NbFichiers = NbFichiers + 1
ReDim Preserve Tableau(1 To NbFichiers)
Tableau(NbFichiers) = Direction
Direction = Dir()
Loop
Cellule = "D33:D33" 'adresse de la cellule contenant les valeurs à recuperer
Feuille = "bon de commande$" 'n'oubliez pas d'ajouter $
If NbFichiers > 0 Then
For X = 1 To NbFichiers 'boucle sur les classeurs
' pour ne pas prendre en compte le classeur contenant la macro(synthese)
If Tableau(X) <> ThisWorkbook.Name Then
Fichier = ThisWorkbook.Path & "" & Tableau(X)
Set Source = New ADODB.Connection
Source.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Fichier & ";Extended Properties=""Excel 8.0;HDR=No;"";"
Set ADOCommand = New ADODB.Command
With ADOCommand
.ActiveConnection = Source
'les données sont dans la "Feuil1" des classeurs fermés
.CommandText = "SELECT * FROM `" & Feuille & Cellule & "`"
End With
Set Rst = New ADODB.Recordset
Rst.Open ADOCommand, , adOpenKeyset, adLockOptimistic
Set Rst = Source.Execute("`" & Feuille & Cellule & "`")
Resultat = Resultat + Rst.Fields(0).Value
Rst.Close
Source.Close
Set Source = Nothing
Set Rst = Nothing
Set ADOCommand = Nothing
End If
Next X
End If
MsgBox "Total commandes :" & Resultat
End Sub
bon week end
michel
Gervaisb
Messages postés
5
Date d'inscription
samedi 10 décembre 2005
Statut
Membre
Dernière intervention
27 février 2006
13 févr. 2006 à 03:08
13 févr. 2006 à 03:08
Super! ça fonctionne très bien. J'ai cherché pour trouver où activer Microsoft ActiveX Data Object 2.x Library mais j'ai fini par trouver.
Merci beaucoup c'est vraiement super.
Bye.
Merci beaucoup c'est vraiement super.
Bye.
