Bonjour à tous,
Je voudrais créer une macro, dans un fichier Excel vierge, qui ferait un
récapitulatif "ciblé" de tous les fichiers contenus dans un dossier
"Clients".
Chaque fichier de ce dossier contient, toujours sur la première page, une
liste qui commence à partir de la ligne 3 jusqu'à n, comme ci-après :
A B C D E
F G
1 ( ligne vide pour touche d'activation de
macros
...)
2 Noms Début Fin Statut I.J. Cie
Jours Total
3 Bombard 13/02/04 30/09/04 NC 2,84 141
477,72
4 Dupont 11/03/03 En cours C 11,56
815 8 279,42
...
L'objectif de la macro de ce nouveau fichier, serait de transférer, pour
chaque fichier du dossier "Clients", toutes les lignes (à partir de la
3ème
ligne) de chaque 1ère page , mais dont la cellule de la colonne C présente
la mention "En cours", et, si possible, de faire précéder ce transfert de
la
ligne par le contenu de la cellule $K$2 (nom du client) de la 1ère feuille
du fichier vers la colonne A
Je ne sais pas si j'ai pu énoncer assez clairement l'objectif de la macro,
ainsi que la composition de chaque fichier. Si nécessaire, je peux joindre
le fichier en cjoint...
Je ne sais pas comment faire pour créer une telle macro, et si il est
possible de le faire sans ouvrir à chaque fois le fichier ?
Merci de vos conseils
Antoine
Bonjour à tous,
Je voudrais créer une macro, dans un fichier Excel vierge, qui ferait un
récapitulatif "ciblé" de tous les fichiers contenus dans un dossier
"Clients".
Chaque fichier de ce dossier contient, toujours sur la première page, une
liste qui commence à partir de la ligne 3 jusqu'à n, comme ci-après :
A B C D E
F G
1 ( ligne vide pour touche d'activation de
macros
...)
2 Noms Début Fin Statut I.J. Cie
Jours Total
3 Bombard 13/02/04 30/09/04 NC 2,84 141
477,72
4 Dupont 11/03/03 En cours C 11,56
815 8 279,42
...
L'objectif de la macro de ce nouveau fichier, serait de transférer, pour
chaque fichier du dossier "Clients", toutes les lignes (à partir de la
3ème
ligne) de chaque 1ère page , mais dont la cellule de la colonne C présente
la mention "En cours", et, si possible, de faire précéder ce transfert de
la
ligne par le contenu de la cellule $K$2 (nom du client) de la 1ère feuille
du fichier vers la colonne A
Je ne sais pas si j'ai pu énoncer assez clairement l'objectif de la macro,
ainsi que la composition de chaque fichier. Si nécessaire, je peux joindre
le fichier en cjoint...
Je ne sais pas comment faire pour créer une telle macro, et si il est
possible de le faire sans ouvrir à chaque fois le fichier ?
Merci de vos conseils
Antoine
Bonjour à tous,
Je voudrais créer une macro, dans un fichier Excel vierge, qui ferait un
récapitulatif "ciblé" de tous les fichiers contenus dans un dossier
"Clients".
Chaque fichier de ce dossier contient, toujours sur la première page, une
liste qui commence à partir de la ligne 3 jusqu'à n, comme ci-après :
A B C D E
F G
1 ( ligne vide pour touche d'activation de
macros
...)
2 Noms Début Fin Statut I.J. Cie
Jours Total
3 Bombard 13/02/04 30/09/04 NC 2,84 141
477,72
4 Dupont 11/03/03 En cours C 11,56
815 8 279,42
...
L'objectif de la macro de ce nouveau fichier, serait de transférer, pour
chaque fichier du dossier "Clients", toutes les lignes (à partir de la
3ème
ligne) de chaque 1ère page , mais dont la cellule de la colonne C présente
la mention "En cours", et, si possible, de faire précéder ce transfert de
la
ligne par le contenu de la cellule $K$2 (nom du client) de la 1ère feuille
du fichier vers la colonne A
Je ne sais pas si j'ai pu énoncer assez clairement l'objectif de la macro,
ainsi que la composition de chaque fichier. Si nécessaire, je peux joindre
le fichier en cjoint...
Je ne sais pas comment faire pour créer une telle macro, et si il est
possible de le faire sans ouvrir à chaque fois le fichier ?
Merci de vos conseils
Antoine
Bonsoir,
le seul truc qui te reste à faire, dans un fichier vierge tu inseres un
module
et y mets cette macro et enregistre ton fichier dans le bon répertoire
(le mm que ceux à ouvrir)sous le nom de Youky(ou à modifier dans la macro)
J'ai pas testé en entier mais je pense que c'est pas mal
Youky
Sub test()
Dim a(200, 20)
chem = ActiveWorkbook.Path
Dim F As String
F = Dir$(chem & "*.xls")
Do Until F = ""
If F = "Youky.xls" Then GoTo saute
Workbooks.Open F
Sheets(1).Select
n = 0
For k = 3 To [C65000].End(xlUp).Row
If Cells(k, 3) = "En cours" Then
n = n + 1
a(n, 1) = [c2]
For b = 2 To 10
a(n, b) = Cells(k, b)
Next b
End If
Next
Workbooks(ActiveWorkbook.Name).Close
For nl = 1 To n
lig = lig + 1
For k = 1 To 10
Cells(lig, k) = a(nl, k)
Next k
Next nl
saute:
F = Dir$
Loop
End Sub
"Antoine76" a écrit dans le message de news:Bonjour à tous,
Je voudrais créer une macro, dans un fichier Excel vierge, qui ferait un
récapitulatif "ciblé" de tous les fichiers contenus dans un dossier
"Clients".
Chaque fichier de ce dossier contient, toujours sur la première page,
une
liste qui commence à partir de la ligne 3 jusqu'à n, comme ci-après :
A B C D
E
F G
1 ( ligne vide pour touche d'activation de
macros
...)
2 Noms Début Fin Statut I.J. Cie
Jours Total
3 Bombard 13/02/04 30/09/04 NC 2,84
141
477,72
4 Dupont 11/03/03 En cours C 11,56
815 8 279,42
...
L'objectif de la macro de ce nouveau fichier, serait de transférer, pour
chaque fichier du dossier "Clients", toutes les lignes (à partir de la
3ème
ligne) de chaque 1ère page , mais dont la cellule de la colonne C
présente
la mention "En cours", et, si possible, de faire précéder ce transfert
de
la
ligne par le contenu de la cellule $K$2 (nom du client) de la 1ère
feuille
du fichier vers la colonne A
Je ne sais pas si j'ai pu énoncer assez clairement l'objectif de la
macro,
ainsi que la composition de chaque fichier. Si nécessaire, je peux
joindre
le fichier en cjoint...
Je ne sais pas comment faire pour créer une telle macro, et si il est
possible de le faire sans ouvrir à chaque fois le fichier ?
Merci de vos conseils
Antoine
Bonsoir,
le seul truc qui te reste à faire, dans un fichier vierge tu inseres un
module
et y mets cette macro et enregistre ton fichier dans le bon répertoire
(le mm que ceux à ouvrir)sous le nom de Youky(ou à modifier dans la macro)
J'ai pas testé en entier mais je pense que c'est pas mal
Youky
Sub test()
Dim a(200, 20)
chem = ActiveWorkbook.Path
Dim F As String
F = Dir$(chem & "*.xls")
Do Until F = ""
If F = "Youky.xls" Then GoTo saute
Workbooks.Open F
Sheets(1).Select
n = 0
For k = 3 To [C65000].End(xlUp).Row
If Cells(k, 3) = "En cours" Then
n = n + 1
a(n, 1) = [c2]
For b = 2 To 10
a(n, b) = Cells(k, b)
Next b
End If
Next
Workbooks(ActiveWorkbook.Name).Close
For nl = 1 To n
lig = lig + 1
For k = 1 To 10
Cells(lig, k) = a(nl, k)
Next k
Next nl
saute:
F = Dir$
Loop
End Sub
"Antoine76" <awerel@mageos.com> a écrit dans le message de news:
u3546Z2EGHA.1424@TK2MSFTNGP12.phx.gbl...
Bonjour à tous,
Je voudrais créer une macro, dans un fichier Excel vierge, qui ferait un
récapitulatif "ciblé" de tous les fichiers contenus dans un dossier
"Clients".
Chaque fichier de ce dossier contient, toujours sur la première page,
une
liste qui commence à partir de la ligne 3 jusqu'à n, comme ci-après :
A B C D
E
F G
1 ( ligne vide pour touche d'activation de
macros
...)
2 Noms Début Fin Statut I.J. Cie
Jours Total
3 Bombard 13/02/04 30/09/04 NC 2,84
141
477,72
4 Dupont 11/03/03 En cours C 11,56
815 8 279,42
...
L'objectif de la macro de ce nouveau fichier, serait de transférer, pour
chaque fichier du dossier "Clients", toutes les lignes (à partir de la
3ème
ligne) de chaque 1ère page , mais dont la cellule de la colonne C
présente
la mention "En cours", et, si possible, de faire précéder ce transfert
de
la
ligne par le contenu de la cellule $K$2 (nom du client) de la 1ère
feuille
du fichier vers la colonne A
Je ne sais pas si j'ai pu énoncer assez clairement l'objectif de la
macro,
ainsi que la composition de chaque fichier. Si nécessaire, je peux
joindre
le fichier en cjoint...
Je ne sais pas comment faire pour créer une telle macro, et si il est
possible de le faire sans ouvrir à chaque fois le fichier ?
Merci de vos conseils
Antoine
Bonsoir,
le seul truc qui te reste à faire, dans un fichier vierge tu inseres un
module
et y mets cette macro et enregistre ton fichier dans le bon répertoire
(le mm que ceux à ouvrir)sous le nom de Youky(ou à modifier dans la macro)
J'ai pas testé en entier mais je pense que c'est pas mal
Youky
Sub test()
Dim a(200, 20)
chem = ActiveWorkbook.Path
Dim F As String
F = Dir$(chem & "*.xls")
Do Until F = ""
If F = "Youky.xls" Then GoTo saute
Workbooks.Open F
Sheets(1).Select
n = 0
For k = 3 To [C65000].End(xlUp).Row
If Cells(k, 3) = "En cours" Then
n = n + 1
a(n, 1) = [c2]
For b = 2 To 10
a(n, b) = Cells(k, b)
Next b
End If
Next
Workbooks(ActiveWorkbook.Name).Close
For nl = 1 To n
lig = lig + 1
For k = 1 To 10
Cells(lig, k) = a(nl, k)
Next k
Next nl
saute:
F = Dir$
Loop
End Sub
"Antoine76" a écrit dans le message de news:Bonjour à tous,
Je voudrais créer une macro, dans un fichier Excel vierge, qui ferait un
récapitulatif "ciblé" de tous les fichiers contenus dans un dossier
"Clients".
Chaque fichier de ce dossier contient, toujours sur la première page,
une
liste qui commence à partir de la ligne 3 jusqu'à n, comme ci-après :
A B C D
E
F G
1 ( ligne vide pour touche d'activation de
macros
...)
2 Noms Début Fin Statut I.J. Cie
Jours Total
3 Bombard 13/02/04 30/09/04 NC 2,84
141
477,72
4 Dupont 11/03/03 En cours C 11,56
815 8 279,42
...
L'objectif de la macro de ce nouveau fichier, serait de transférer, pour
chaque fichier du dossier "Clients", toutes les lignes (à partir de la
3ème
ligne) de chaque 1ère page , mais dont la cellule de la colonne C
présente
la mention "En cours", et, si possible, de faire précéder ce transfert
de
la
ligne par le contenu de la cellule $K$2 (nom du client) de la 1ère
feuille
du fichier vers la colonne A
Je ne sais pas si j'ai pu énoncer assez clairement l'objectif de la
macro,
ainsi que la composition de chaque fichier. Si nécessaire, je peux
joindre
le fichier en cjoint...
Je ne sais pas comment faire pour créer une telle macro, et si il est
possible de le faire sans ouvrir à chaque fois le fichier ?
Merci de vos conseils
Antoine
la manière d'utiliser Dim a(200, 20),
Cela crée un tableau à 2 dimensions
le rôle du $
pas sur de moi mais en principe cela fait que la variable est considérée
Bonsoir Youki,
Merci pour ta réponse. J'étais de sortie samedi soir, et je viens
seulement
de tester ton programme. Il fonctionne bien, à un petit détail près : je
ne
t'ai pas précisé que la 1ère page de tous les fichiers source sollicités
est
déjà le fruit d'une réactualisation en Auto_Open (à partir de l'ensemble
des
autres feuilles du classeur) ; c'est ce qui me fait apparaître le message
:
" Erreur d'exécution 1004...'Arrêt de travail Peugeot.xls' est
introuvable.
Vérifier l'orthographe du nom du classeur et la validité de
l'emplacement..."
J'ai essayé en supprimant la macro Auto_Open, cela fonctionne super.
J'ai essayé d'insérer "Application.DisplayAlerts = False" ou/et
" ActiveWorkbook.RunAutoMacros (xlAutoOpen)" ou
Workbooks(F).RunAutoMacros (xlAutoOpen), mais cela ne change rien!
Est-ce qu'il y a une solution pour le faire fonctionner en gardant cette
Auto_Open (identique à tous les fichiers) ?
Petite question annexe, dans le code que tu as écris, je ne comprends pas
plusieurs petites chose que tu as écrites et qui fonctionnent très bien,
comme :
la manière d'utiliser Dim a(200, 20),
le rôle du $ dans Dir$(chem & "*.xls"),
et à quoi correspond la lettre "a" qui ne semble pas être une variable et
que je n'ai pas trouvé comme fonction ?
Dans tous les cas, Grand Merci pour ta contribution !
Antoine
"Youky" a écrit dans le message de news:
43c033a0$0$19695$Bonsoir,
le seul truc qui te reste à faire, dans un fichier vierge tu inseres un
module
et y mets cette macro et enregistre ton fichier dans le bon répertoire
(le mm que ceux à ouvrir)sous le nom de Youky(ou à modifier dans la
macro)
J'ai pas testé en entier mais je pense que c'est pas mal
Youky
Sub test()
Dim a(200, 20)
chem = ActiveWorkbook.Path
Dim F As String
F = Dir$(chem & "*.xls")
Do Until F = ""
If F = "Youky.xls" Then GoTo saute
Workbooks.Open F
Sheets(1).Select
n = 0
For k = 3 To [C65000].End(xlUp).Row
If Cells(k, 3) = "En cours" Then
n = n + 1
a(n, 1) = [c2]
For b = 2 To 10
a(n, b) = Cells(k, b)
Next b
End If
Next
Workbooks(ActiveWorkbook.Name).Close
For nl = 1 To n
lig = lig + 1
For k = 1 To 10
Cells(lig, k) = a(nl, k)
Next k
Next nl
saute:
F = Dir$
Loop
End Sub
"Antoine76" a écrit dans le message de news:Bonjour à tous,
Je voudrais créer une macro, dans un fichier Excel vierge, qui ferait
un
récapitulatif "ciblé" de tous les fichiers contenus dans un dossier
"Clients".
Chaque fichier de ce dossier contient, toujours sur la première page,
uneliste qui commence à partir de la ligne 3 jusqu'à n, comme ci-après :
A B C D
EF G
1 ( ligne vide pour touche d'activation de
macros
...)
2 Noms Début Fin Statut I.J.
Cie
Jours Total
3 Bombard 13/02/04 30/09/04 NC 2,84
141477,72
4 Dupont 11/03/03 En cours C 11,56
815 8 279,42
...
L'objectif de la macro de ce nouveau fichier, serait de transférer,
pour
chaque fichier du dossier "Clients", toutes les lignes (à partir de la
3ème
ligne) de chaque 1ère page , mais dont la cellule de la colonne C
présentela mention "En cours", et, si possible, de faire précéder ce transfert
dela
ligne par le contenu de la cellule $K$2 (nom du client) de la 1ère
feuilledu fichier vers la colonne A
Je ne sais pas si j'ai pu énoncer assez clairement l'objectif de la
macro,ainsi que la composition de chaque fichier. Si nécessaire, je peux
joindrele fichier en cjoint...
Je ne sais pas comment faire pour créer une telle macro, et si il est
possible de le faire sans ouvrir à chaque fois le fichier ?
Merci de vos conseils
Antoine
la manière d'utiliser Dim a(200, 20),
Cela crée un tableau à 2 dimensions
le rôle du $
pas sur de moi mais en principe cela fait que la variable est considérée
Bonsoir Youki,
Merci pour ta réponse. J'étais de sortie samedi soir, et je viens
seulement
de tester ton programme. Il fonctionne bien, à un petit détail près : je
ne
t'ai pas précisé que la 1ère page de tous les fichiers source sollicités
est
déjà le fruit d'une réactualisation en Auto_Open (à partir de l'ensemble
des
autres feuilles du classeur) ; c'est ce qui me fait apparaître le message
:
" Erreur d'exécution 1004...'Arrêt de travail Peugeot.xls' est
introuvable.
Vérifier l'orthographe du nom du classeur et la validité de
l'emplacement..."
J'ai essayé en supprimant la macro Auto_Open, cela fonctionne super.
J'ai essayé d'insérer "Application.DisplayAlerts = False" ou/et
" ActiveWorkbook.RunAutoMacros (xlAutoOpen)" ou
Workbooks(F).RunAutoMacros (xlAutoOpen), mais cela ne change rien!
Est-ce qu'il y a une solution pour le faire fonctionner en gardant cette
Auto_Open (identique à tous les fichiers) ?
Petite question annexe, dans le code que tu as écris, je ne comprends pas
plusieurs petites chose que tu as écrites et qui fonctionnent très bien,
comme :
la manière d'utiliser Dim a(200, 20),
le rôle du $ dans Dir$(chem & "*.xls"),
et à quoi correspond la lettre "a" qui ne semble pas être une variable et
que je n'ai pas trouvé comme fonction ?
Dans tous les cas, Grand Merci pour ta contribution !
Antoine
"Youky" <bruno.jeune@wanadoo.fr> a écrit dans le message de news:
43c033a0$0$19695$8fcfb975@news.wanadoo.fr...
Bonsoir,
le seul truc qui te reste à faire, dans un fichier vierge tu inseres un
module
et y mets cette macro et enregistre ton fichier dans le bon répertoire
(le mm que ceux à ouvrir)sous le nom de Youky(ou à modifier dans la
macro)
J'ai pas testé en entier mais je pense que c'est pas mal
Youky
Sub test()
Dim a(200, 20)
chem = ActiveWorkbook.Path
Dim F As String
F = Dir$(chem & "*.xls")
Do Until F = ""
If F = "Youky.xls" Then GoTo saute
Workbooks.Open F
Sheets(1).Select
n = 0
For k = 3 To [C65000].End(xlUp).Row
If Cells(k, 3) = "En cours" Then
n = n + 1
a(n, 1) = [c2]
For b = 2 To 10
a(n, b) = Cells(k, b)
Next b
End If
Next
Workbooks(ActiveWorkbook.Name).Close
For nl = 1 To n
lig = lig + 1
For k = 1 To 10
Cells(lig, k) = a(nl, k)
Next k
Next nl
saute:
F = Dir$
Loop
End Sub
"Antoine76" <awerel@mageos.com> a écrit dans le message de news:
u3546Z2EGHA.1424@TK2MSFTNGP12.phx.gbl...
Bonjour à tous,
Je voudrais créer une macro, dans un fichier Excel vierge, qui ferait
un
récapitulatif "ciblé" de tous les fichiers contenus dans un dossier
"Clients".
Chaque fichier de ce dossier contient, toujours sur la première page,
une
liste qui commence à partir de la ligne 3 jusqu'à n, comme ci-après :
A B C D
E
F G
1 ( ligne vide pour touche d'activation de
macros
...)
2 Noms Début Fin Statut I.J.
Cie
Jours Total
3 Bombard 13/02/04 30/09/04 NC 2,84
141
477,72
4 Dupont 11/03/03 En cours C 11,56
815 8 279,42
...
L'objectif de la macro de ce nouveau fichier, serait de transférer,
pour
chaque fichier du dossier "Clients", toutes les lignes (à partir de la
3ème
ligne) de chaque 1ère page , mais dont la cellule de la colonne C
présente
la mention "En cours", et, si possible, de faire précéder ce transfert
de
la
ligne par le contenu de la cellule $K$2 (nom du client) de la 1ère
feuille
du fichier vers la colonne A
Je ne sais pas si j'ai pu énoncer assez clairement l'objectif de la
macro,
ainsi que la composition de chaque fichier. Si nécessaire, je peux
joindre
le fichier en cjoint...
Je ne sais pas comment faire pour créer une telle macro, et si il est
possible de le faire sans ouvrir à chaque fois le fichier ?
Merci de vos conseils
Antoine
la manière d'utiliser Dim a(200, 20),
Cela crée un tableau à 2 dimensions
le rôle du $
pas sur de moi mais en principe cela fait que la variable est considérée
Bonsoir Youki,
Merci pour ta réponse. J'étais de sortie samedi soir, et je viens
seulement
de tester ton programme. Il fonctionne bien, à un petit détail près : je
ne
t'ai pas précisé que la 1ère page de tous les fichiers source sollicités
est
déjà le fruit d'une réactualisation en Auto_Open (à partir de l'ensemble
des
autres feuilles du classeur) ; c'est ce qui me fait apparaître le message
:
" Erreur d'exécution 1004...'Arrêt de travail Peugeot.xls' est
introuvable.
Vérifier l'orthographe du nom du classeur et la validité de
l'emplacement..."
J'ai essayé en supprimant la macro Auto_Open, cela fonctionne super.
J'ai essayé d'insérer "Application.DisplayAlerts = False" ou/et
" ActiveWorkbook.RunAutoMacros (xlAutoOpen)" ou
Workbooks(F).RunAutoMacros (xlAutoOpen), mais cela ne change rien!
Est-ce qu'il y a une solution pour le faire fonctionner en gardant cette
Auto_Open (identique à tous les fichiers) ?
Petite question annexe, dans le code que tu as écris, je ne comprends pas
plusieurs petites chose que tu as écrites et qui fonctionnent très bien,
comme :
la manière d'utiliser Dim a(200, 20),
le rôle du $ dans Dir$(chem & "*.xls"),
et à quoi correspond la lettre "a" qui ne semble pas être une variable et
que je n'ai pas trouvé comme fonction ?
Dans tous les cas, Grand Merci pour ta contribution !
Antoine
"Youky" a écrit dans le message de news:
43c033a0$0$19695$Bonsoir,
le seul truc qui te reste à faire, dans un fichier vierge tu inseres un
module
et y mets cette macro et enregistre ton fichier dans le bon répertoire
(le mm que ceux à ouvrir)sous le nom de Youky(ou à modifier dans la
macro)
J'ai pas testé en entier mais je pense que c'est pas mal
Youky
Sub test()
Dim a(200, 20)
chem = ActiveWorkbook.Path
Dim F As String
F = Dir$(chem & "*.xls")
Do Until F = ""
If F = "Youky.xls" Then GoTo saute
Workbooks.Open F
Sheets(1).Select
n = 0
For k = 3 To [C65000].End(xlUp).Row
If Cells(k, 3) = "En cours" Then
n = n + 1
a(n, 1) = [c2]
For b = 2 To 10
a(n, b) = Cells(k, b)
Next b
End If
Next
Workbooks(ActiveWorkbook.Name).Close
For nl = 1 To n
lig = lig + 1
For k = 1 To 10
Cells(lig, k) = a(nl, k)
Next k
Next nl
saute:
F = Dir$
Loop
End Sub
"Antoine76" a écrit dans le message de news:Bonjour à tous,
Je voudrais créer une macro, dans un fichier Excel vierge, qui ferait
un
récapitulatif "ciblé" de tous les fichiers contenus dans un dossier
"Clients".
Chaque fichier de ce dossier contient, toujours sur la première page,
uneliste qui commence à partir de la ligne 3 jusqu'à n, comme ci-après :
A B C D
EF G
1 ( ligne vide pour touche d'activation de
macros
...)
2 Noms Début Fin Statut I.J.
Cie
Jours Total
3 Bombard 13/02/04 30/09/04 NC 2,84
141477,72
4 Dupont 11/03/03 En cours C 11,56
815 8 279,42
...
L'objectif de la macro de ce nouveau fichier, serait de transférer,
pour
chaque fichier du dossier "Clients", toutes les lignes (à partir de la
3ème
ligne) de chaque 1ère page , mais dont la cellule de la colonne C
présentela mention "En cours", et, si possible, de faire précéder ce transfert
dela
ligne par le contenu de la cellule $K$2 (nom du client) de la 1ère
feuilledu fichier vers la colonne A
Je ne sais pas si j'ai pu énoncer assez clairement l'objectif de la
macro,ainsi que la composition de chaque fichier. Si nécessaire, je peux
joindrele fichier en cjoint...
Je ne sais pas comment faire pour créer une telle macro, et si il est
possible de le faire sans ouvrir à chaque fois le fichier ?
Merci de vos conseils
Antoine
Salut Antoine,
Pour l'auto_Open je n'ai pas de solutions.
Je pense qu'il est plus facile de mettre la macro en :
Private Sub Workbook_Open()
plutôt qu'en Auto_Open
Ne sachant pas ce que fait cette macro dur dur.
Là je sèche, pose la question de nouveau au forumla manière d'utiliser Dim a(200, 20),
Cela crée un tableau à 2 dimensions
le 1er de 0 à 200 et le deuxieme 0 à 20
ce qui fait que je peux y loger 200 lignes sur 20 colonnes
ici 200 indique le nbre maxi de lignes pouvant être gardées en mémoire
bien sur que les "En cours" et pour 1 seule page
car au changement de fichier c'est réactualisé
si ligne=3 et colonne =1
a(ligne,colonne)="Antoine"
a(3,1) va renvoyer "Antoine"le rôle du $
pas sur de moi mais en principe cela fait que la variable est considérée
comme du texte
c'est de moins en moins utilisé, peut être que ca marche sans le $, à
essayer
Youky
"Antoine76" a écrit dans le message de news:Bonsoir Youki,
Merci pour ta réponse. J'étais de sortie samedi soir, et je viens
seulement
de tester ton programme. Il fonctionne bien, à un petit détail près : je
ne
t'ai pas précisé que la 1ère page de tous les fichiers source sollicités
est
déjà le fruit d'une réactualisation en Auto_Open (à partir de l'ensemble
des
autres feuilles du classeur) ; c'est ce qui me fait apparaître le
message
:
" Erreur d'exécution 1004...'Arrêt de travail Peugeot.xls' est
introuvable.
Vérifier l'orthographe du nom du classeur et la validité de
l'emplacement..."
J'ai essayé en supprimant la macro Auto_Open, cela fonctionne super.
J'ai essayé d'insérer "Application.DisplayAlerts = False" ou/et
" ActiveWorkbook.RunAutoMacros (xlAutoOpen)" ou
Workbooks(F).RunAutoMacros (xlAutoOpen), mais cela ne change rien!
Est-ce qu'il y a une solution pour le faire fonctionner en gardant cette
Auto_Open (identique à tous les fichiers) ?
Petite question annexe, dans le code que tu as écris, je ne comprends
pas
plusieurs petites chose que tu as écrites et qui fonctionnent très bien,
comme :
la manière d'utiliser Dim a(200, 20),
le rôle du $ dans Dir$(chem & "*.xls"),
et à quoi correspond la lettre "a" qui ne semble pas être une variable
et
que je n'ai pas trouvé comme fonction ?
Dans tous les cas, Grand Merci pour ta contribution !
Antoine
"Youky" a écrit dans le message de news:
43c033a0$0$19695$Bonsoir,
le seul truc qui te reste à faire, dans un fichier vierge tu inseres un
module
et y mets cette macro et enregistre ton fichier dans le bon répertoire
(le mm que ceux à ouvrir)sous le nom de Youky(ou à modifier dans la
macro)
J'ai pas testé en entier mais je pense que c'est pas mal
Youky
Sub test()
Dim a(200, 20)
chem = ActiveWorkbook.Path
Dim F As String
F = Dir$(chem & "*.xls")
Do Until F = ""
If F = "Youky.xls" Then GoTo saute
Workbooks.Open F
Sheets(1).Select
n = 0
For k = 3 To [C65000].End(xlUp).Row
If Cells(k, 3) = "En cours" Then
n = n + 1
a(n, 1) = [c2]
For b = 2 To 10
a(n, b) = Cells(k, b)
Next b
End If
Next
Workbooks(ActiveWorkbook.Name).Close
For nl = 1 To n
lig = lig + 1
For k = 1 To 10
Cells(lig, k) = a(nl, k)
Next k
Next nl
saute:
F = Dir$
Loop
End Sub
"Antoine76" a écrit dans le message de news:Bonjour à tous,
Je voudrais créer une macro, dans un fichier Excel vierge, qui ferait
un
récapitulatif "ciblé" de tous les fichiers contenus dans un dossier
"Clients".
Chaque fichier de ce dossier contient, toujours sur la première page,
uneliste qui commence à partir de la ligne 3 jusqu'à n, comme ci-après :
A B C D
EF G
1 ( ligne vide pour touche d'activation de
macros
...)
2 Noms Début Fin Statut I.J.
Cie
Jours Total
3 Bombard 13/02/04 30/09/04 NC 2,84
141477,72
4 Dupont 11/03/03 En cours C 11,56
815 8 279,42
...
L'objectif de la macro de ce nouveau fichier, serait de transférer,
pour
chaque fichier du dossier "Clients", toutes les lignes (à partir de
la
3ème
ligne) de chaque 1ère page , mais dont la cellule de la colonne C
présentela mention "En cours", et, si possible, de faire précéder ce
transfert
dela
ligne par le contenu de la cellule $K$2 (nom du client) de la 1ère
feuilledu fichier vers la colonne A
Je ne sais pas si j'ai pu énoncer assez clairement l'objectif de la
macro,ainsi que la composition de chaque fichier. Si nécessaire, je peux
joindrele fichier en cjoint...
Je ne sais pas comment faire pour créer une telle macro, et si il est
possible de le faire sans ouvrir à chaque fois le fichier ?
Merci de vos conseils
Antoine
Salut Antoine,
Pour l'auto_Open je n'ai pas de solutions.
Je pense qu'il est plus facile de mettre la macro en :
Private Sub Workbook_Open()
plutôt qu'en Auto_Open
Ne sachant pas ce que fait cette macro dur dur.
Là je sèche, pose la question de nouveau au forum
la manière d'utiliser Dim a(200, 20),
Cela crée un tableau à 2 dimensions
le 1er de 0 à 200 et le deuxieme 0 à 20
ce qui fait que je peux y loger 200 lignes sur 20 colonnes
ici 200 indique le nbre maxi de lignes pouvant être gardées en mémoire
bien sur que les "En cours" et pour 1 seule page
car au changement de fichier c'est réactualisé
si ligne=3 et colonne =1
a(ligne,colonne)="Antoine"
a(3,1) va renvoyer "Antoine"
le rôle du $
pas sur de moi mais en principe cela fait que la variable est considérée
comme du texte
c'est de moins en moins utilisé, peut être que ca marche sans le $, à
essayer
Youky
"Antoine76" <awerel@mageos.com> a écrit dans le message de news:
eRosxjHFGHA.1088@tk2msftngp13.phx.gbl...
Bonsoir Youki,
Merci pour ta réponse. J'étais de sortie samedi soir, et je viens
seulement
de tester ton programme. Il fonctionne bien, à un petit détail près : je
ne
t'ai pas précisé que la 1ère page de tous les fichiers source sollicités
est
déjà le fruit d'une réactualisation en Auto_Open (à partir de l'ensemble
des
autres feuilles du classeur) ; c'est ce qui me fait apparaître le
message
:
" Erreur d'exécution 1004...'Arrêt de travail Peugeot.xls' est
introuvable.
Vérifier l'orthographe du nom du classeur et la validité de
l'emplacement..."
J'ai essayé en supprimant la macro Auto_Open, cela fonctionne super.
J'ai essayé d'insérer "Application.DisplayAlerts = False" ou/et
" ActiveWorkbook.RunAutoMacros (xlAutoOpen)" ou
Workbooks(F).RunAutoMacros (xlAutoOpen), mais cela ne change rien!
Est-ce qu'il y a une solution pour le faire fonctionner en gardant cette
Auto_Open (identique à tous les fichiers) ?
Petite question annexe, dans le code que tu as écris, je ne comprends
pas
plusieurs petites chose que tu as écrites et qui fonctionnent très bien,
comme :
la manière d'utiliser Dim a(200, 20),
le rôle du $ dans Dir$(chem & "*.xls"),
et à quoi correspond la lettre "a" qui ne semble pas être une variable
et
que je n'ai pas trouvé comme fonction ?
Dans tous les cas, Grand Merci pour ta contribution !
Antoine
"Youky" <bruno.jeune@wanadoo.fr> a écrit dans le message de news:
43c033a0$0$19695$8fcfb975@news.wanadoo.fr...
Bonsoir,
le seul truc qui te reste à faire, dans un fichier vierge tu inseres un
module
et y mets cette macro et enregistre ton fichier dans le bon répertoire
(le mm que ceux à ouvrir)sous le nom de Youky(ou à modifier dans la
macro)
J'ai pas testé en entier mais je pense que c'est pas mal
Youky
Sub test()
Dim a(200, 20)
chem = ActiveWorkbook.Path
Dim F As String
F = Dir$(chem & "*.xls")
Do Until F = ""
If F = "Youky.xls" Then GoTo saute
Workbooks.Open F
Sheets(1).Select
n = 0
For k = 3 To [C65000].End(xlUp).Row
If Cells(k, 3) = "En cours" Then
n = n + 1
a(n, 1) = [c2]
For b = 2 To 10
a(n, b) = Cells(k, b)
Next b
End If
Next
Workbooks(ActiveWorkbook.Name).Close
For nl = 1 To n
lig = lig + 1
For k = 1 To 10
Cells(lig, k) = a(nl, k)
Next k
Next nl
saute:
F = Dir$
Loop
End Sub
"Antoine76" <awerel@mageos.com> a écrit dans le message de news:
u3546Z2EGHA.1424@TK2MSFTNGP12.phx.gbl...
Bonjour à tous,
Je voudrais créer une macro, dans un fichier Excel vierge, qui ferait
un
récapitulatif "ciblé" de tous les fichiers contenus dans un dossier
"Clients".
Chaque fichier de ce dossier contient, toujours sur la première page,
une
liste qui commence à partir de la ligne 3 jusqu'à n, comme ci-après :
A B C D
E
F G
1 ( ligne vide pour touche d'activation de
macros
...)
2 Noms Début Fin Statut I.J.
Cie
Jours Total
3 Bombard 13/02/04 30/09/04 NC 2,84
141
477,72
4 Dupont 11/03/03 En cours C 11,56
815 8 279,42
...
L'objectif de la macro de ce nouveau fichier, serait de transférer,
pour
chaque fichier du dossier "Clients", toutes les lignes (à partir de
la
3ème
ligne) de chaque 1ère page , mais dont la cellule de la colonne C
présente
la mention "En cours", et, si possible, de faire précéder ce
transfert
de
la
ligne par le contenu de la cellule $K$2 (nom du client) de la 1ère
feuille
du fichier vers la colonne A
Je ne sais pas si j'ai pu énoncer assez clairement l'objectif de la
macro,
ainsi que la composition de chaque fichier. Si nécessaire, je peux
joindre
le fichier en cjoint...
Je ne sais pas comment faire pour créer une telle macro, et si il est
possible de le faire sans ouvrir à chaque fois le fichier ?
Merci de vos conseils
Antoine
Salut Antoine,
Pour l'auto_Open je n'ai pas de solutions.
Je pense qu'il est plus facile de mettre la macro en :
Private Sub Workbook_Open()
plutôt qu'en Auto_Open
Ne sachant pas ce que fait cette macro dur dur.
Là je sèche, pose la question de nouveau au forumla manière d'utiliser Dim a(200, 20),
Cela crée un tableau à 2 dimensions
le 1er de 0 à 200 et le deuxieme 0 à 20
ce qui fait que je peux y loger 200 lignes sur 20 colonnes
ici 200 indique le nbre maxi de lignes pouvant être gardées en mémoire
bien sur que les "En cours" et pour 1 seule page
car au changement de fichier c'est réactualisé
si ligne=3 et colonne =1
a(ligne,colonne)="Antoine"
a(3,1) va renvoyer "Antoine"le rôle du $
pas sur de moi mais en principe cela fait que la variable est considérée
comme du texte
c'est de moins en moins utilisé, peut être que ca marche sans le $, à
essayer
Youky
"Antoine76" a écrit dans le message de news:Bonsoir Youki,
Merci pour ta réponse. J'étais de sortie samedi soir, et je viens
seulement
de tester ton programme. Il fonctionne bien, à un petit détail près : je
ne
t'ai pas précisé que la 1ère page de tous les fichiers source sollicités
est
déjà le fruit d'une réactualisation en Auto_Open (à partir de l'ensemble
des
autres feuilles du classeur) ; c'est ce qui me fait apparaître le
message
:
" Erreur d'exécution 1004...'Arrêt de travail Peugeot.xls' est
introuvable.
Vérifier l'orthographe du nom du classeur et la validité de
l'emplacement..."
J'ai essayé en supprimant la macro Auto_Open, cela fonctionne super.
J'ai essayé d'insérer "Application.DisplayAlerts = False" ou/et
" ActiveWorkbook.RunAutoMacros (xlAutoOpen)" ou
Workbooks(F).RunAutoMacros (xlAutoOpen), mais cela ne change rien!
Est-ce qu'il y a une solution pour le faire fonctionner en gardant cette
Auto_Open (identique à tous les fichiers) ?
Petite question annexe, dans le code que tu as écris, je ne comprends
pas
plusieurs petites chose que tu as écrites et qui fonctionnent très bien,
comme :
la manière d'utiliser Dim a(200, 20),
le rôle du $ dans Dir$(chem & "*.xls"),
et à quoi correspond la lettre "a" qui ne semble pas être une variable
et
que je n'ai pas trouvé comme fonction ?
Dans tous les cas, Grand Merci pour ta contribution !
Antoine
"Youky" a écrit dans le message de news:
43c033a0$0$19695$Bonsoir,
le seul truc qui te reste à faire, dans un fichier vierge tu inseres un
module
et y mets cette macro et enregistre ton fichier dans le bon répertoire
(le mm que ceux à ouvrir)sous le nom de Youky(ou à modifier dans la
macro)
J'ai pas testé en entier mais je pense que c'est pas mal
Youky
Sub test()
Dim a(200, 20)
chem = ActiveWorkbook.Path
Dim F As String
F = Dir$(chem & "*.xls")
Do Until F = ""
If F = "Youky.xls" Then GoTo saute
Workbooks.Open F
Sheets(1).Select
n = 0
For k = 3 To [C65000].End(xlUp).Row
If Cells(k, 3) = "En cours" Then
n = n + 1
a(n, 1) = [c2]
For b = 2 To 10
a(n, b) = Cells(k, b)
Next b
End If
Next
Workbooks(ActiveWorkbook.Name).Close
For nl = 1 To n
lig = lig + 1
For k = 1 To 10
Cells(lig, k) = a(nl, k)
Next k
Next nl
saute:
F = Dir$
Loop
End Sub
"Antoine76" a écrit dans le message de news:Bonjour à tous,
Je voudrais créer une macro, dans un fichier Excel vierge, qui ferait
un
récapitulatif "ciblé" de tous les fichiers contenus dans un dossier
"Clients".
Chaque fichier de ce dossier contient, toujours sur la première page,
uneliste qui commence à partir de la ligne 3 jusqu'à n, comme ci-après :
A B C D
EF G
1 ( ligne vide pour touche d'activation de
macros
...)
2 Noms Début Fin Statut I.J.
Cie
Jours Total
3 Bombard 13/02/04 30/09/04 NC 2,84
141477,72
4 Dupont 11/03/03 En cours C 11,56
815 8 279,42
...
L'objectif de la macro de ce nouveau fichier, serait de transférer,
pour
chaque fichier du dossier "Clients", toutes les lignes (à partir de
la
3ème
ligne) de chaque 1ère page , mais dont la cellule de la colonne C
présentela mention "En cours", et, si possible, de faire précéder ce
transfert
dela
ligne par le contenu de la cellule $K$2 (nom du client) de la 1ère
feuilledu fichier vers la colonne A
Je ne sais pas si j'ai pu énoncer assez clairement l'objectif de la
macro,ainsi que la composition de chaque fichier. Si nécessaire, je peux
joindrele fichier en cjoint...
Je ne sais pas comment faire pour créer une telle macro, et si il est
possible de le faire sans ouvrir à chaque fois le fichier ?
Merci de vos conseils
Antoine
Rebonsoir Youki
En Auto_Open, j'ai une "mise à jour" de "l'état d'avancement de dossier"
correspondant à chaque feuille (transfert du lien H pour un accès rapide,
et
recopie des cellules contenant différentes valeur caractéristiques de
l'évolution de chaque dossier) ; Pour plus d'Info , j'ai déposé les lignes
de code (réalisé pour une bonne part grace à MFPE) à la fin de ce message.
Sur ta proposition, j'ai transféré l'ensemble de ces lignes de programme
sur
Workbook_Open, ce qui me donne exactement le même résultat (no comment !).
Ton idée était donc plus que recevable!
Quant à la macro que tu m'as écrite, elle fonctionne dans ce cas
IMPECCABLEMENT (no comment bis !).
A propos de ta macro, il est toujours très intéressant de voir comment
"d'autre(s)" font une macro que l'on ne sait pas soi-même appréhender ;
c'est peut-être là que l'on apprend le plus !...
Merci à toi
Antoine
' désactive le rafraîchissement de l'écran
Application.ScreenUpdating = False
' déclaration des variables du classement alphabétique
Dim a(256), j As Integer, k As Integer, n As Integer, temp
' comptage du nombre de feuilles
n = Sheets.Count
For j = 1 To n
a(j) = Sheets(j).Name
Next j
' tri des feuilles
For j = 1 To n
For k = j To n
If a(k) < a(j) Then
temp = a(k)
a(k) = a(j)
a(j) = temp
End If
Next k
Next j
' positionnement des feuilles selon la lettre
For j = 1 To n
Sheets(a(j)).Move before:=Sheets(j)
Next j
' déclaration des variables de la feuille sommaire
Dim wsh As Worksheet, i As Integer, H As Hyperlink, x As String, R
As Range
' met la feuille Arrêt de travail type en Nième position des feuilles
Sheets("Arrêt de travail type").Move After:=Sheets(Sheets.Count)
' met la feuille Sommaire en 1ère position des feuilles
Sheets("Sommaire").Move before:=Sheets(1)
' efface toutes les celules de la feuille Sommaire
Range("A:H").Select
Selection.ClearContents
' sélectionne la cellule B1 de la feuille "Sommaire"
Sheets("Sommaire").Select
' cycle de création des transfert de valeurs
Range("B1").Select
For Each wsh In ActiveWorkbook.Sheets
i = i + 1
' créé en colonne B un lien hypertexte pour toutes les feuilles du
classeur
ActiveSheet.Hyperlinks.Add Anchor:Îlls(i + 1, 1), Address:="", _
SubAddress:="'" & wsh.Name & "'" & "!A1", TextToDisplay:=wsh.Name
' transfert de la date/début (B9 de chaque feuille) sur la feuille
"Sommaire"
Cells(i + 1, 2) = wsh.Range("B9")
' transfert l'état "En cours/Soldé" (D4 de chaque feuille) sur la
feuille "Sommaire"
Cells(i + 1, 3) = wsh.Range("D4")
' la remplace par la date de dernière I.J. de compagnie de chaque
feuille sur la feuille "Sommaire"
If Not LCase(Cells(i + 1, 3)) Like "en cours" Then Cells(i + 1, 3)_
Application.WorksheetFunction.Max(wsh.Range("J9:J200"))
' transfert l'état "Cadre/Non Cadre" (C3 de chaque feuille) sur la
feuille "Sommaire"
Cells(i + 1, 4) = wsh.Range("C3")
' transfert de la dernière I.J. Compagnie versée sur la feuille
"Sommaire"
Cells(i + 1, 5) = wsh.Range("N25")
' transfert du nombre de jours Compagnie (somme de P11 à P200) sur la
feuille "Sommaire"
Cells(i + 1, 6) > Application.WorksheetFunction.Sum(wsh.Range("P11:P200"))
' transfert des I.J. totales versées /Compagnie (somme de K8 à K200)
sur la feuille "Sommaire"
Cells(i + 1, 7) > Application.WorksheetFunction.Sum(wsh.Range("K9:K200"))
Next
' suprime le lien hyperT et les 3 cellules de droite de la 2ème ligne
For Each H In Worksheets("Sommaire").Hyperlinks
If InStr(1, H.SubAddress, "Sommaire") Then
Set R = Range(H.Parent.Address)
R = "Salariés en arrêt"
Set R = R.Offset(0, 1)
R = "Début d' arrêt"
Set R = R.Offset(0, 1)
R = "Fin d' arrêt"
Set R = R.Offset(0, 1)
R = "Statut"
Set R = R.Offset(0, 1)
R = "I.J. Cie / jour"
Set R = R.Offset(0, 1)
R = "Nb. de jours"
Set R = R.Offset(0, 1)
R = "I.J. Cie cumulées"
H.Delete
End If
Next
' met en couleur les 7 cellules de titres
Range("A2:G2").Select
With Selection.Interior
.ColorIndex = 36
.Pattern = xlSolid
End With
With Selection.Font
.Name = "Arial"
.FontStyle = "Gras"
.Size = 12
.ColorIndex = 9
End With
' supprime les 6 cellules de droite du lien hyperT de Arrêt de travail
type
For Each H In Worksheets("Sommaire").Hyperlinks
If InStr(1, H.SubAddress, "Arrêt de travail type") Then
Set R = Range(H.Parent.Address)
Set R = R.Offset(0, 1)
R = ""
Set R = R.Offset(0, 1)
R = ""
Set R = R.Offset(0, 1)
R = ""
Set R = R.Offset(0, 1)
R = ""
Set R = R.Offset(0, 1)
R = ""
Set R = R.Offset(0, 1)
R = ""
End If
Next
' applique à A2 le format de cellule de B2
Range("B2").Select
Selection.Copy
Range("A2").Select
Selection.PasteSpecial Paste:=xlFormats
Application.CutCopyMode = False
' réactive le rafraîchissement de l'écran
Application.ScreenUpdating = True
Range("A1").Select
End Sub
"Youky" a écrit dans le message de news:
43c15d47$0$6661$Salut Antoine,
Pour l'auto_Open je n'ai pas de solutions.
Je pense qu'il est plus facile de mettre la macro en :
Private Sub Workbook_Open()
plutôt qu'en Auto_Open
Ne sachant pas ce que fait cette macro dur dur.
Là je sèche, pose la question de nouveau au forumla manière d'utiliser Dim a(200, 20),
Cela crée un tableau à 2 dimensions
le 1er de 0 à 200 et le deuxieme 0 à 20
ce qui fait que je peux y loger 200 lignes sur 20 colonnes
ici 200 indique le nbre maxi de lignes pouvant être gardées en mémoire
bien sur que les "En cours" et pour 1 seule page
car au changement de fichier c'est réactualisé
si ligne=3 et colonne =1
a(ligne,colonne)="Antoine"
a(3,1) va renvoyer "Antoine"le rôle du $
pas sur de moi mais en principe cela fait que la variable est considérée
comme du texte
c'est de moins en moins utilisé, peut être que ca marche sans le $, à
essayer
Youky
"Antoine76" a écrit dans le message de news:Bonsoir Youki,
Merci pour ta réponse. J'étais de sortie samedi soir, et je viens
seulement
de tester ton programme. Il fonctionne bien, à un petit détail près :
je
ne
t'ai pas précisé que la 1ère page de tous les fichiers source
sollicités
est
déjà le fruit d'une réactualisation en Auto_Open (à partir de
l'ensemble
des
autres feuilles du classeur) ; c'est ce qui me fait apparaître le
message:
" Erreur d'exécution 1004...'Arrêt de travail Peugeot.xls' est
introuvable.
Vérifier l'orthographe du nom du classeur et la validité de
l'emplacement..."
J'ai essayé en supprimant la macro Auto_Open, cela fonctionne super.
J'ai essayé d'insérer "Application.DisplayAlerts = False" ou/et
" ActiveWorkbook.RunAutoMacros (xlAutoOpen)" ou
Workbooks(F).RunAutoMacros (xlAutoOpen), mais cela ne change rien!
Est-ce qu'il y a une solution pour le faire fonctionner en gardant
cette
Auto_Open (identique à tous les fichiers) ?
Petite question annexe, dans le code que tu as écris, je ne comprends
pasplusieurs petites chose que tu as écrites et qui fonctionnent très
bien,
comme :
la manière d'utiliser Dim a(200, 20),
le rôle du $ dans Dir$(chem & "*.xls"),
et à quoi correspond la lettre "a" qui ne semble pas être une variable
etque je n'ai pas trouvé comme fonction ?
Dans tous les cas, Grand Merci pour ta contribution !
Antoine
"Youky" a écrit dans le message de news:
43c033a0$0$19695$Bonsoir,
le seul truc qui te reste à faire, dans un fichier vierge tu inseres
un
module
et y mets cette macro et enregistre ton fichier dans le bon répertoire
(le mm que ceux à ouvrir)sous le nom de Youky(ou à modifier dans la
macro)
J'ai pas testé en entier mais je pense que c'est pas mal
Youky
Sub test()
Dim a(200, 20)
chem = ActiveWorkbook.Path
Dim F As String
F = Dir$(chem & "*.xls")
Do Until F = ""
If F = "Youky.xls" Then GoTo saute
Workbooks.Open F
Sheets(1).Select
n = 0
For k = 3 To [C65000].End(xlUp).Row
If Cells(k, 3) = "En cours" Then
n = n + 1
a(n, 1) = [c2]
For b = 2 To 10
a(n, b) = Cells(k, b)
Next b
End If
Next
Workbooks(ActiveWorkbook.Name).Close
For nl = 1 To n
lig = lig + 1
For k = 1 To 10
Cells(lig, k) = a(nl, k)
Next k
Next nl
saute:
F = Dir$
Loop
End Sub
"Antoine76" a écrit dans le message de news:Bonjour à tous,
Je voudrais créer une macro, dans un fichier Excel vierge, qui
ferait
un
récapitulatif "ciblé" de tous les fichiers contenus dans un dossier
"Clients".
Chaque fichier de ce dossier contient, toujours sur la première
page,
uneliste qui commence à partir de la ligne 3 jusqu'à n, comme ci-après
:
A B C D
EF G
1 ( ligne vide pour touche d'activation
de
macros
...)
2 Noms Début Fin Statut I.J.
Cie
Jours Total
3 Bombard 13/02/04 30/09/04 NC 2,84
141477,72
4 Dupont 11/03/03 En cours C 11,56
815 8 279,42
...
L'objectif de la macro de ce nouveau fichier, serait de transférer,
pour
chaque fichier du dossier "Clients", toutes les lignes (à partir de
la3ème
ligne) de chaque 1ère page , mais dont la cellule de la colonne C
présentela mention "En cours", et, si possible, de faire précéder ce
transfertdela
ligne par le contenu de la cellule $K$2 (nom du client) de la 1ère
feuilledu fichier vers la colonne A
Je ne sais pas si j'ai pu énoncer assez clairement l'objectif de la
macro,ainsi que la composition de chaque fichier. Si nécessaire, je peux
joindrele fichier en cjoint...
Je ne sais pas comment faire pour créer une telle macro, et si il
est
possible de le faire sans ouvrir à chaque fois le fichier ?
Merci de vos conseils
Antoine
Rebonsoir Youki
En Auto_Open, j'ai une "mise à jour" de "l'état d'avancement de dossier"
correspondant à chaque feuille (transfert du lien H pour un accès rapide,
et
recopie des cellules contenant différentes valeur caractéristiques de
l'évolution de chaque dossier) ; Pour plus d'Info , j'ai déposé les lignes
de code (réalisé pour une bonne part grace à MFPE) à la fin de ce message.
Sur ta proposition, j'ai transféré l'ensemble de ces lignes de programme
sur
Workbook_Open, ce qui me donne exactement le même résultat (no comment !).
Ton idée était donc plus que recevable!
Quant à la macro que tu m'as écrite, elle fonctionne dans ce cas
IMPECCABLEMENT (no comment bis !).
A propos de ta macro, il est toujours très intéressant de voir comment
"d'autre(s)" font une macro que l'on ne sait pas soi-même appréhender ;
c'est peut-être là que l'on apprend le plus !...
Merci à toi
Antoine
' désactive le rafraîchissement de l'écran
Application.ScreenUpdating = False
' déclaration des variables du classement alphabétique
Dim a(256), j As Integer, k As Integer, n As Integer, temp
' comptage du nombre de feuilles
n = Sheets.Count
For j = 1 To n
a(j) = Sheets(j).Name
Next j
' tri des feuilles
For j = 1 To n
For k = j To n
If a(k) < a(j) Then
temp = a(k)
a(k) = a(j)
a(j) = temp
End If
Next k
Next j
' positionnement des feuilles selon la lettre
For j = 1 To n
Sheets(a(j)).Move before:=Sheets(j)
Next j
' déclaration des variables de la feuille sommaire
Dim wsh As Worksheet, i As Integer, H As Hyperlink, x As String, R
As Range
' met la feuille Arrêt de travail type en Nième position des feuilles
Sheets("Arrêt de travail type").Move After:=Sheets(Sheets.Count)
' met la feuille Sommaire en 1ère position des feuilles
Sheets("Sommaire").Move before:=Sheets(1)
' efface toutes les celules de la feuille Sommaire
Range("A:H").Select
Selection.ClearContents
' sélectionne la cellule B1 de la feuille "Sommaire"
Sheets("Sommaire").Select
' cycle de création des transfert de valeurs
Range("B1").Select
For Each wsh In ActiveWorkbook.Sheets
i = i + 1
' créé en colonne B un lien hypertexte pour toutes les feuilles du
classeur
ActiveSheet.Hyperlinks.Add Anchor:Îlls(i + 1, 1), Address:="", _
SubAddress:="'" & wsh.Name & "'" & "!A1", TextToDisplay:=wsh.Name
' transfert de la date/début (B9 de chaque feuille) sur la feuille
"Sommaire"
Cells(i + 1, 2) = wsh.Range("B9")
' transfert l'état "En cours/Soldé" (D4 de chaque feuille) sur la
feuille "Sommaire"
Cells(i + 1, 3) = wsh.Range("D4")
' la remplace par la date de dernière I.J. de compagnie de chaque
feuille sur la feuille "Sommaire"
If Not LCase(Cells(i + 1, 3)) Like "en cours" Then Cells(i + 1, 3)
_
Application.WorksheetFunction.Max(wsh.Range("J9:J200"))
' transfert l'état "Cadre/Non Cadre" (C3 de chaque feuille) sur la
feuille "Sommaire"
Cells(i + 1, 4) = wsh.Range("C3")
' transfert de la dernière I.J. Compagnie versée sur la feuille
"Sommaire"
Cells(i + 1, 5) = wsh.Range("N25")
' transfert du nombre de jours Compagnie (somme de P11 à P200) sur la
feuille "Sommaire"
Cells(i + 1, 6) > Application.WorksheetFunction.Sum(wsh.Range("P11:P200"))
' transfert des I.J. totales versées /Compagnie (somme de K8 à K200)
sur la feuille "Sommaire"
Cells(i + 1, 7) > Application.WorksheetFunction.Sum(wsh.Range("K9:K200"))
Next
' suprime le lien hyperT et les 3 cellules de droite de la 2ème ligne
For Each H In Worksheets("Sommaire").Hyperlinks
If InStr(1, H.SubAddress, "Sommaire") Then
Set R = Range(H.Parent.Address)
R = "Salariés en arrêt"
Set R = R.Offset(0, 1)
R = "Début d' arrêt"
Set R = R.Offset(0, 1)
R = "Fin d' arrêt"
Set R = R.Offset(0, 1)
R = "Statut"
Set R = R.Offset(0, 1)
R = "I.J. Cie / jour"
Set R = R.Offset(0, 1)
R = "Nb. de jours"
Set R = R.Offset(0, 1)
R = "I.J. Cie cumulées"
H.Delete
End If
Next
' met en couleur les 7 cellules de titres
Range("A2:G2").Select
With Selection.Interior
.ColorIndex = 36
.Pattern = xlSolid
End With
With Selection.Font
.Name = "Arial"
.FontStyle = "Gras"
.Size = 12
.ColorIndex = 9
End With
' supprime les 6 cellules de droite du lien hyperT de Arrêt de travail
type
For Each H In Worksheets("Sommaire").Hyperlinks
If InStr(1, H.SubAddress, "Arrêt de travail type") Then
Set R = Range(H.Parent.Address)
Set R = R.Offset(0, 1)
R = ""
Set R = R.Offset(0, 1)
R = ""
Set R = R.Offset(0, 1)
R = ""
Set R = R.Offset(0, 1)
R = ""
Set R = R.Offset(0, 1)
R = ""
Set R = R.Offset(0, 1)
R = ""
End If
Next
' applique à A2 le format de cellule de B2
Range("B2").Select
Selection.Copy
Range("A2").Select
Selection.PasteSpecial Paste:=xlFormats
Application.CutCopyMode = False
' réactive le rafraîchissement de l'écran
Application.ScreenUpdating = True
Range("A1").Select
End Sub
"Youky" <bruno.jeune@wanadoo.fr> a écrit dans le message de news:
43c15d47$0$6661$8fcfb975@news.wanadoo.fr...
Salut Antoine,
Pour l'auto_Open je n'ai pas de solutions.
Je pense qu'il est plus facile de mettre la macro en :
Private Sub Workbook_Open()
plutôt qu'en Auto_Open
Ne sachant pas ce que fait cette macro dur dur.
Là je sèche, pose la question de nouveau au forum
la manière d'utiliser Dim a(200, 20),
Cela crée un tableau à 2 dimensions
le 1er de 0 à 200 et le deuxieme 0 à 20
ce qui fait que je peux y loger 200 lignes sur 20 colonnes
ici 200 indique le nbre maxi de lignes pouvant être gardées en mémoire
bien sur que les "En cours" et pour 1 seule page
car au changement de fichier c'est réactualisé
si ligne=3 et colonne =1
a(ligne,colonne)="Antoine"
a(3,1) va renvoyer "Antoine"
le rôle du $
pas sur de moi mais en principe cela fait que la variable est considérée
comme du texte
c'est de moins en moins utilisé, peut être que ca marche sans le $, à
essayer
Youky
"Antoine76" <awerel@mageos.com> a écrit dans le message de news:
eRosxjHFGHA.1088@tk2msftngp13.phx.gbl...
Bonsoir Youki,
Merci pour ta réponse. J'étais de sortie samedi soir, et je viens
seulement
de tester ton programme. Il fonctionne bien, à un petit détail près :
je
ne
t'ai pas précisé que la 1ère page de tous les fichiers source
sollicités
est
déjà le fruit d'une réactualisation en Auto_Open (à partir de
l'ensemble
des
autres feuilles du classeur) ; c'est ce qui me fait apparaître le
message
:
" Erreur d'exécution 1004...'Arrêt de travail Peugeot.xls' est
introuvable.
Vérifier l'orthographe du nom du classeur et la validité de
l'emplacement..."
J'ai essayé en supprimant la macro Auto_Open, cela fonctionne super.
J'ai essayé d'insérer "Application.DisplayAlerts = False" ou/et
" ActiveWorkbook.RunAutoMacros (xlAutoOpen)" ou
Workbooks(F).RunAutoMacros (xlAutoOpen), mais cela ne change rien!
Est-ce qu'il y a une solution pour le faire fonctionner en gardant
cette
Auto_Open (identique à tous les fichiers) ?
Petite question annexe, dans le code que tu as écris, je ne comprends
pas
plusieurs petites chose que tu as écrites et qui fonctionnent très
bien,
comme :
la manière d'utiliser Dim a(200, 20),
le rôle du $ dans Dir$(chem & "*.xls"),
et à quoi correspond la lettre "a" qui ne semble pas être une variable
et
que je n'ai pas trouvé comme fonction ?
Dans tous les cas, Grand Merci pour ta contribution !
Antoine
"Youky" <bruno.jeune@wanadoo.fr> a écrit dans le message de news:
43c033a0$0$19695$8fcfb975@news.wanadoo.fr...
Bonsoir,
le seul truc qui te reste à faire, dans un fichier vierge tu inseres
un
module
et y mets cette macro et enregistre ton fichier dans le bon répertoire
(le mm que ceux à ouvrir)sous le nom de Youky(ou à modifier dans la
macro)
J'ai pas testé en entier mais je pense que c'est pas mal
Youky
Sub test()
Dim a(200, 20)
chem = ActiveWorkbook.Path
Dim F As String
F = Dir$(chem & "*.xls")
Do Until F = ""
If F = "Youky.xls" Then GoTo saute
Workbooks.Open F
Sheets(1).Select
n = 0
For k = 3 To [C65000].End(xlUp).Row
If Cells(k, 3) = "En cours" Then
n = n + 1
a(n, 1) = [c2]
For b = 2 To 10
a(n, b) = Cells(k, b)
Next b
End If
Next
Workbooks(ActiveWorkbook.Name).Close
For nl = 1 To n
lig = lig + 1
For k = 1 To 10
Cells(lig, k) = a(nl, k)
Next k
Next nl
saute:
F = Dir$
Loop
End Sub
"Antoine76" <awerel@mageos.com> a écrit dans le message de news:
u3546Z2EGHA.1424@TK2MSFTNGP12.phx.gbl...
Bonjour à tous,
Je voudrais créer une macro, dans un fichier Excel vierge, qui
ferait
un
récapitulatif "ciblé" de tous les fichiers contenus dans un dossier
"Clients".
Chaque fichier de ce dossier contient, toujours sur la première
page,
une
liste qui commence à partir de la ligne 3 jusqu'à n, comme ci-après
:
A B C D
E
F G
1 ( ligne vide pour touche d'activation
de
macros
...)
2 Noms Début Fin Statut I.J.
Cie
Jours Total
3 Bombard 13/02/04 30/09/04 NC 2,84
141
477,72
4 Dupont 11/03/03 En cours C 11,56
815 8 279,42
...
L'objectif de la macro de ce nouveau fichier, serait de transférer,
pour
chaque fichier du dossier "Clients", toutes les lignes (à partir de
la
3ème
ligne) de chaque 1ère page , mais dont la cellule de la colonne C
présente
la mention "En cours", et, si possible, de faire précéder ce
transfert
de
la
ligne par le contenu de la cellule $K$2 (nom du client) de la 1ère
feuille
du fichier vers la colonne A
Je ne sais pas si j'ai pu énoncer assez clairement l'objectif de la
macro,
ainsi que la composition de chaque fichier. Si nécessaire, je peux
joindre
le fichier en cjoint...
Je ne sais pas comment faire pour créer une telle macro, et si il
est
possible de le faire sans ouvrir à chaque fois le fichier ?
Merci de vos conseils
Antoine
Rebonsoir Youki
En Auto_Open, j'ai une "mise à jour" de "l'état d'avancement de dossier"
correspondant à chaque feuille (transfert du lien H pour un accès rapide,
et
recopie des cellules contenant différentes valeur caractéristiques de
l'évolution de chaque dossier) ; Pour plus d'Info , j'ai déposé les lignes
de code (réalisé pour une bonne part grace à MFPE) à la fin de ce message.
Sur ta proposition, j'ai transféré l'ensemble de ces lignes de programme
sur
Workbook_Open, ce qui me donne exactement le même résultat (no comment !).
Ton idée était donc plus que recevable!
Quant à la macro que tu m'as écrite, elle fonctionne dans ce cas
IMPECCABLEMENT (no comment bis !).
A propos de ta macro, il est toujours très intéressant de voir comment
"d'autre(s)" font une macro que l'on ne sait pas soi-même appréhender ;
c'est peut-être là que l'on apprend le plus !...
Merci à toi
Antoine
' désactive le rafraîchissement de l'écran
Application.ScreenUpdating = False
' déclaration des variables du classement alphabétique
Dim a(256), j As Integer, k As Integer, n As Integer, temp
' comptage du nombre de feuilles
n = Sheets.Count
For j = 1 To n
a(j) = Sheets(j).Name
Next j
' tri des feuilles
For j = 1 To n
For k = j To n
If a(k) < a(j) Then
temp = a(k)
a(k) = a(j)
a(j) = temp
End If
Next k
Next j
' positionnement des feuilles selon la lettre
For j = 1 To n
Sheets(a(j)).Move before:=Sheets(j)
Next j
' déclaration des variables de la feuille sommaire
Dim wsh As Worksheet, i As Integer, H As Hyperlink, x As String, R
As Range
' met la feuille Arrêt de travail type en Nième position des feuilles
Sheets("Arrêt de travail type").Move After:=Sheets(Sheets.Count)
' met la feuille Sommaire en 1ère position des feuilles
Sheets("Sommaire").Move before:=Sheets(1)
' efface toutes les celules de la feuille Sommaire
Range("A:H").Select
Selection.ClearContents
' sélectionne la cellule B1 de la feuille "Sommaire"
Sheets("Sommaire").Select
' cycle de création des transfert de valeurs
Range("B1").Select
For Each wsh In ActiveWorkbook.Sheets
i = i + 1
' créé en colonne B un lien hypertexte pour toutes les feuilles du
classeur
ActiveSheet.Hyperlinks.Add Anchor:Îlls(i + 1, 1), Address:="", _
SubAddress:="'" & wsh.Name & "'" & "!A1", TextToDisplay:=wsh.Name
' transfert de la date/début (B9 de chaque feuille) sur la feuille
"Sommaire"
Cells(i + 1, 2) = wsh.Range("B9")
' transfert l'état "En cours/Soldé" (D4 de chaque feuille) sur la
feuille "Sommaire"
Cells(i + 1, 3) = wsh.Range("D4")
' la remplace par la date de dernière I.J. de compagnie de chaque
feuille sur la feuille "Sommaire"
If Not LCase(Cells(i + 1, 3)) Like "en cours" Then Cells(i + 1, 3)_
Application.WorksheetFunction.Max(wsh.Range("J9:J200"))
' transfert l'état "Cadre/Non Cadre" (C3 de chaque feuille) sur la
feuille "Sommaire"
Cells(i + 1, 4) = wsh.Range("C3")
' transfert de la dernière I.J. Compagnie versée sur la feuille
"Sommaire"
Cells(i + 1, 5) = wsh.Range("N25")
' transfert du nombre de jours Compagnie (somme de P11 à P200) sur la
feuille "Sommaire"
Cells(i + 1, 6) > Application.WorksheetFunction.Sum(wsh.Range("P11:P200"))
' transfert des I.J. totales versées /Compagnie (somme de K8 à K200)
sur la feuille "Sommaire"
Cells(i + 1, 7) > Application.WorksheetFunction.Sum(wsh.Range("K9:K200"))
Next
' suprime le lien hyperT et les 3 cellules de droite de la 2ème ligne
For Each H In Worksheets("Sommaire").Hyperlinks
If InStr(1, H.SubAddress, "Sommaire") Then
Set R = Range(H.Parent.Address)
R = "Salariés en arrêt"
Set R = R.Offset(0, 1)
R = "Début d' arrêt"
Set R = R.Offset(0, 1)
R = "Fin d' arrêt"
Set R = R.Offset(0, 1)
R = "Statut"
Set R = R.Offset(0, 1)
R = "I.J. Cie / jour"
Set R = R.Offset(0, 1)
R = "Nb. de jours"
Set R = R.Offset(0, 1)
R = "I.J. Cie cumulées"
H.Delete
End If
Next
' met en couleur les 7 cellules de titres
Range("A2:G2").Select
With Selection.Interior
.ColorIndex = 36
.Pattern = xlSolid
End With
With Selection.Font
.Name = "Arial"
.FontStyle = "Gras"
.Size = 12
.ColorIndex = 9
End With
' supprime les 6 cellules de droite du lien hyperT de Arrêt de travail
type
For Each H In Worksheets("Sommaire").Hyperlinks
If InStr(1, H.SubAddress, "Arrêt de travail type") Then
Set R = Range(H.Parent.Address)
Set R = R.Offset(0, 1)
R = ""
Set R = R.Offset(0, 1)
R = ""
Set R = R.Offset(0, 1)
R = ""
Set R = R.Offset(0, 1)
R = ""
Set R = R.Offset(0, 1)
R = ""
Set R = R.Offset(0, 1)
R = ""
End If
Next
' applique à A2 le format de cellule de B2
Range("B2").Select
Selection.Copy
Range("A2").Select
Selection.PasteSpecial Paste:=xlFormats
Application.CutCopyMode = False
' réactive le rafraîchissement de l'écran
Application.ScreenUpdating = True
Range("A1").Select
End Sub
"Youky" a écrit dans le message de news:
43c15d47$0$6661$Salut Antoine,
Pour l'auto_Open je n'ai pas de solutions.
Je pense qu'il est plus facile de mettre la macro en :
Private Sub Workbook_Open()
plutôt qu'en Auto_Open
Ne sachant pas ce que fait cette macro dur dur.
Là je sèche, pose la question de nouveau au forumla manière d'utiliser Dim a(200, 20),
Cela crée un tableau à 2 dimensions
le 1er de 0 à 200 et le deuxieme 0 à 20
ce qui fait que je peux y loger 200 lignes sur 20 colonnes
ici 200 indique le nbre maxi de lignes pouvant être gardées en mémoire
bien sur que les "En cours" et pour 1 seule page
car au changement de fichier c'est réactualisé
si ligne=3 et colonne =1
a(ligne,colonne)="Antoine"
a(3,1) va renvoyer "Antoine"le rôle du $
pas sur de moi mais en principe cela fait que la variable est considérée
comme du texte
c'est de moins en moins utilisé, peut être que ca marche sans le $, à
essayer
Youky
"Antoine76" a écrit dans le message de news:Bonsoir Youki,
Merci pour ta réponse. J'étais de sortie samedi soir, et je viens
seulement
de tester ton programme. Il fonctionne bien, à un petit détail près :
je
ne
t'ai pas précisé que la 1ère page de tous les fichiers source
sollicités
est
déjà le fruit d'une réactualisation en Auto_Open (à partir de
l'ensemble
des
autres feuilles du classeur) ; c'est ce qui me fait apparaître le
message:
" Erreur d'exécution 1004...'Arrêt de travail Peugeot.xls' est
introuvable.
Vérifier l'orthographe du nom du classeur et la validité de
l'emplacement..."
J'ai essayé en supprimant la macro Auto_Open, cela fonctionne super.
J'ai essayé d'insérer "Application.DisplayAlerts = False" ou/et
" ActiveWorkbook.RunAutoMacros (xlAutoOpen)" ou
Workbooks(F).RunAutoMacros (xlAutoOpen), mais cela ne change rien!
Est-ce qu'il y a une solution pour le faire fonctionner en gardant
cette
Auto_Open (identique à tous les fichiers) ?
Petite question annexe, dans le code que tu as écris, je ne comprends
pasplusieurs petites chose que tu as écrites et qui fonctionnent très
bien,
comme :
la manière d'utiliser Dim a(200, 20),
le rôle du $ dans Dir$(chem & "*.xls"),
et à quoi correspond la lettre "a" qui ne semble pas être une variable
etque je n'ai pas trouvé comme fonction ?
Dans tous les cas, Grand Merci pour ta contribution !
Antoine
"Youky" a écrit dans le message de news:
43c033a0$0$19695$Bonsoir,
le seul truc qui te reste à faire, dans un fichier vierge tu inseres
un
module
et y mets cette macro et enregistre ton fichier dans le bon répertoire
(le mm que ceux à ouvrir)sous le nom de Youky(ou à modifier dans la
macro)
J'ai pas testé en entier mais je pense que c'est pas mal
Youky
Sub test()
Dim a(200, 20)
chem = ActiveWorkbook.Path
Dim F As String
F = Dir$(chem & "*.xls")
Do Until F = ""
If F = "Youky.xls" Then GoTo saute
Workbooks.Open F
Sheets(1).Select
n = 0
For k = 3 To [C65000].End(xlUp).Row
If Cells(k, 3) = "En cours" Then
n = n + 1
a(n, 1) = [c2]
For b = 2 To 10
a(n, b) = Cells(k, b)
Next b
End If
Next
Workbooks(ActiveWorkbook.Name).Close
For nl = 1 To n
lig = lig + 1
For k = 1 To 10
Cells(lig, k) = a(nl, k)
Next k
Next nl
saute:
F = Dir$
Loop
End Sub
"Antoine76" a écrit dans le message de news:Bonjour à tous,
Je voudrais créer une macro, dans un fichier Excel vierge, qui
ferait
un
récapitulatif "ciblé" de tous les fichiers contenus dans un dossier
"Clients".
Chaque fichier de ce dossier contient, toujours sur la première
page,
uneliste qui commence à partir de la ligne 3 jusqu'à n, comme ci-après
:
A B C D
EF G
1 ( ligne vide pour touche d'activation
de
macros
...)
2 Noms Début Fin Statut I.J.
Cie
Jours Total
3 Bombard 13/02/04 30/09/04 NC 2,84
141477,72
4 Dupont 11/03/03 En cours C 11,56
815 8 279,42
...
L'objectif de la macro de ce nouveau fichier, serait de transférer,
pour
chaque fichier du dossier "Clients", toutes les lignes (à partir de
la3ème
ligne) de chaque 1ère page , mais dont la cellule de la colonne C
présentela mention "En cours", et, si possible, de faire précéder ce
transfertdela
ligne par le contenu de la cellule $K$2 (nom du client) de la 1ère
feuilledu fichier vers la colonne A
Je ne sais pas si j'ai pu énoncer assez clairement l'objectif de la
macro,ainsi que la composition de chaque fichier. Si nécessaire, je peux
joindrele fichier en cjoint...
Je ne sais pas comment faire pour créer une telle macro, et si il
est
possible de le faire sans ouvrir à chaque fois le fichier ?
Merci de vos conseils
Antoine
Trés belle macro, superbe, et quand tout fonctionne la magie fait son
oeuvre.
Cela m'a fait plaisir d'avoir réussit ta demande.
Youky
A+
"Antoine76" a écrit dans le message de news:Rebonsoir Youki
En Auto_Open, j'ai une "mise à jour" de "l'état d'avancement de dossier"
correspondant à chaque feuille (transfert du lien H pour un accès
rapide,
et
recopie des cellules contenant différentes valeur caractéristiques de
l'évolution de chaque dossier) ; Pour plus d'Info , j'ai déposé les
lignes
de code (réalisé pour une bonne part grace à MFPE) à la fin de ce
message.
Sur ta proposition, j'ai transféré l'ensemble de ces lignes de programme
sur
Workbook_Open, ce qui me donne exactement le même résultat (no comment
!).
Ton idée était donc plus que recevable!
Quant à la macro que tu m'as écrite, elle fonctionne dans ce cas
IMPECCABLEMENT (no comment bis !).
A propos de ta macro, il est toujours très intéressant de voir comment
"d'autre(s)" font une macro que l'on ne sait pas soi-même appréhender ;
c'est peut-être là que l'on apprend le plus !...
Merci à toi
Antoine
' désactive le rafraîchissement de l'écran
Application.ScreenUpdating = False
' déclaration des variables du classement alphabétique
Dim a(256), j As Integer, k As Integer, n As Integer, temp
' comptage du nombre de feuilles
n = Sheets.Count
For j = 1 To n
a(j) = Sheets(j).Name
Next j
' tri des feuilles
For j = 1 To n
For k = j To n
If a(k) < a(j) Then
temp = a(k)
a(k) = a(j)
a(j) = temp
End If
Next k
Next j
' positionnement des feuilles selon la lettre
For j = 1 To n
Sheets(a(j)).Move before:=Sheets(j)
Next j
' déclaration des variables de la feuille sommaire
Dim wsh As Worksheet, i As Integer, H As Hyperlink, x As String,
R
As Range
' met la feuille Arrêt de travail type en Nième position des feuilles
Sheets("Arrêt de travail type").Move After:=Sheets(Sheets.Count)
' met la feuille Sommaire en 1ère position des feuilles
Sheets("Sommaire").Move before:=Sheets(1)
' efface toutes les celules de la feuille Sommaire
Range("A:H").Select
Selection.ClearContents
' sélectionne la cellule B1 de la feuille "Sommaire"
Sheets("Sommaire").Select
' cycle de création des transfert de valeurs
Range("B1").Select
For Each wsh In ActiveWorkbook.Sheets
i = i + 1
' créé en colonne B un lien hypertexte pour toutes les feuilles du
classeur
ActiveSheet.Hyperlinks.Add Anchor:Îlls(i + 1, 1), Address:="",
_
SubAddress:="'" & wsh.Name & "'" & "!A1", TextToDisplay:=wsh.Name
' transfert de la date/début (B9 de chaque feuille) sur la feuille
"Sommaire"
Cells(i + 1, 2) = wsh.Range("B9")
' transfert l'état "En cours/Soldé" (D4 de chaque feuille) sur la
feuille "Sommaire"
Cells(i + 1, 3) = wsh.Range("D4")
' la remplace par la date de dernière I.J. de compagnie de chaque
feuille sur la feuille "Sommaire"
If Not LCase(Cells(i + 1, 3)) Like "en cours" Then Cells(i + 1,
3)
_
Application.WorksheetFunction.Max(wsh.Range("J9:J200"))
' transfert l'état "Cadre/Non Cadre" (C3 de chaque feuille) sur la
feuille "Sommaire"
Cells(i + 1, 4) = wsh.Range("C3")
' transfert de la dernière I.J. Compagnie versée sur la feuille
"Sommaire"
Cells(i + 1, 5) = wsh.Range("N25")
' transfert du nombre de jours Compagnie (somme de P11 à P200) sur la
feuille "Sommaire"
Cells(i + 1, 6) > > Application.WorksheetFunction.Sum(wsh.Range("P11:P200"))
' transfert des I.J. totales versées /Compagnie (somme de K8 à K200)
sur la feuille "Sommaire"
Cells(i + 1, 7) > > Application.WorksheetFunction.Sum(wsh.Range("K9:K200"))
Next
' suprime le lien hyperT et les 3 cellules de droite de la 2ème ligne
For Each H In Worksheets("Sommaire").Hyperlinks
If InStr(1, H.SubAddress, "Sommaire") Then
Set R = Range(H.Parent.Address)
R = "Salariés en arrêt"
Set R = R.Offset(0, 1)
R = "Début d' arrêt"
Set R = R.Offset(0, 1)
R = "Fin d' arrêt"
Set R = R.Offset(0, 1)
R = "Statut"
Set R = R.Offset(0, 1)
R = "I.J. Cie / jour"
Set R = R.Offset(0, 1)
R = "Nb. de jours"
Set R = R.Offset(0, 1)
R = "I.J. Cie cumulées"
H.Delete
End If
Next
' met en couleur les 7 cellules de titres
Range("A2:G2").Select
With Selection.Interior
.ColorIndex = 36
.Pattern = xlSolid
End With
With Selection.Font
.Name = "Arial"
.FontStyle = "Gras"
.Size = 12
.ColorIndex = 9
End With
' supprime les 6 cellules de droite du lien hyperT de Arrêt de travail
type
For Each H In Worksheets("Sommaire").Hyperlinks
If InStr(1, H.SubAddress, "Arrêt de travail type") Then
Set R = Range(H.Parent.Address)
Set R = R.Offset(0, 1)
R = ""
Set R = R.Offset(0, 1)
R = ""
Set R = R.Offset(0, 1)
R = ""
Set R = R.Offset(0, 1)
R = ""
Set R = R.Offset(0, 1)
R = ""
Set R = R.Offset(0, 1)
R = ""
End If
Next
' applique à A2 le format de cellule de B2
Range("B2").Select
Selection.Copy
Range("A2").Select
Selection.PasteSpecial Paste:=xlFormats
Application.CutCopyMode = False
' réactive le rafraîchissement de l'écran
Application.ScreenUpdating = True
Range("A1").Select
End Sub
"Youky" a écrit dans le message de news:
43c15d47$0$6661$Salut Antoine,
Pour l'auto_Open je n'ai pas de solutions.
Je pense qu'il est plus facile de mettre la macro en :
Private Sub Workbook_Open()
plutôt qu'en Auto_Open
Ne sachant pas ce que fait cette macro dur dur.
Là je sèche, pose la question de nouveau au forumla manière d'utiliser Dim a(200, 20),
Cela crée un tableau à 2 dimensions
le 1er de 0 à 200 et le deuxieme 0 à 20
ce qui fait que je peux y loger 200 lignes sur 20 colonnes
ici 200 indique le nbre maxi de lignes pouvant être gardées en mémoire
bien sur que les "En cours" et pour 1 seule page
car au changement de fichier c'est réactualisé
si ligne=3 et colonne =1
a(ligne,colonne)="Antoine"
a(3,1) va renvoyer "Antoine"le rôle du $
pas sur de moi mais en principe cela fait que la variable est
considérée
comme du texte
c'est de moins en moins utilisé, peut être que ca marche sans le $, à
essayer
Youky
"Antoine76" a écrit dans le message de news:Bonsoir Youki,
Merci pour ta réponse. J'étais de sortie samedi soir, et je viens
seulement
de tester ton programme. Il fonctionne bien, à un petit détail près :
je
ne
t'ai pas précisé que la 1ère page de tous les fichiers source
sollicités
est
déjà le fruit d'une réactualisation en Auto_Open (à partir de
l'ensemble
des
autres feuilles du classeur) ; c'est ce qui me fait apparaître le
message:
" Erreur d'exécution 1004...'Arrêt de travail Peugeot.xls' est
introuvable.
Vérifier l'orthographe du nom du classeur et la validité de
l'emplacement..."
J'ai essayé en supprimant la macro Auto_Open, cela fonctionne super.
J'ai essayé d'insérer "Application.DisplayAlerts = False" ou/et
" ActiveWorkbook.RunAutoMacros (xlAutoOpen)" ou
Workbooks(F).RunAutoMacros (xlAutoOpen), mais cela ne change rien!
Est-ce qu'il y a une solution pour le faire fonctionner en gardant
cette
Auto_Open (identique à tous les fichiers) ?
Petite question annexe, dans le code que tu as écris, je ne comprends
pasplusieurs petites chose que tu as écrites et qui fonctionnent très
bien,
comme :
la manière d'utiliser Dim a(200, 20),
le rôle du $ dans Dir$(chem & "*.xls"),
et à quoi correspond la lettre "a" qui ne semble pas être une
variable
etque je n'ai pas trouvé comme fonction ?
Dans tous les cas, Grand Merci pour ta contribution !
Antoine
"Youky" a écrit dans le message de news:
43c033a0$0$19695$Bonsoir,
le seul truc qui te reste à faire, dans un fichier vierge tu inseres
un
module
et y mets cette macro et enregistre ton fichier dans le bon
répertoire
(le mm que ceux à ouvrir)sous le nom de Youky(ou à modifier dans la
macro)
J'ai pas testé en entier mais je pense que c'est pas mal
Youky
Sub test()
Dim a(200, 20)
chem = ActiveWorkbook.Path
Dim F As String
F = Dir$(chem & "*.xls")
Do Until F = ""
If F = "Youky.xls" Then GoTo saute
Workbooks.Open F
Sheets(1).Select
n = 0
For k = 3 To [C65000].End(xlUp).Row
If Cells(k, 3) = "En cours" Then
n = n + 1
a(n, 1) = [c2]
For b = 2 To 10
a(n, b) = Cells(k, b)
Next b
End If
Next
Workbooks(ActiveWorkbook.Name).Close
For nl = 1 To n
lig = lig + 1
For k = 1 To 10
Cells(lig, k) = a(nl, k)
Next k
Next nl
saute:
F = Dir$
Loop
End Sub
"Antoine76" a écrit dans le message de news:Bonjour à tous,
Je voudrais créer une macro, dans un fichier Excel vierge, qui
ferait
un
récapitulatif "ciblé" de tous les fichiers contenus dans un
dossier
"Clients".
Chaque fichier de ce dossier contient, toujours sur la première
page,
uneliste qui commence à partir de la ligne 3 jusqu'à n, comme
ci-après
:
A B C D
EF G
1 ( ligne vide pour touche d'activation
de
macros
...)
2 Noms Début Fin Statut
I.J.
Cie
Jours Total
3 Bombard 13/02/04 30/09/04 NC 2,84
141477,72
4 Dupont 11/03/03 En cours C 11,56
815 8 279,42
...
L'objectif de la macro de ce nouveau fichier, serait de
transférer,
pour
chaque fichier du dossier "Clients", toutes les lignes (à partir
de
la3ème
ligne) de chaque 1ère page , mais dont la cellule de la colonne C
présentela mention "En cours", et, si possible, de faire précéder ce
transfertdela
ligne par le contenu de la cellule $K$2 (nom du client) de la 1ère
feuilledu fichier vers la colonne A
Je ne sais pas si j'ai pu énoncer assez clairement l'objectif de
la
macro,ainsi que la composition de chaque fichier. Si nécessaire, je peux
joindrele fichier en cjoint...
Je ne sais pas comment faire pour créer une telle macro, et si il
est
possible de le faire sans ouvrir à chaque fois le fichier ?
Merci de vos conseils
Antoine
Trés belle macro, superbe, et quand tout fonctionne la magie fait son
oeuvre.
Cela m'a fait plaisir d'avoir réussit ta demande.
Youky
A+
"Antoine76" <awerel@mageos.com> a écrit dans le message de news:
unZ6bFJFGHA.2012@TK2MSFTNGP14.phx.gbl...
Rebonsoir Youki
En Auto_Open, j'ai une "mise à jour" de "l'état d'avancement de dossier"
correspondant à chaque feuille (transfert du lien H pour un accès
rapide,
et
recopie des cellules contenant différentes valeur caractéristiques de
l'évolution de chaque dossier) ; Pour plus d'Info , j'ai déposé les
lignes
de code (réalisé pour une bonne part grace à MFPE) à la fin de ce
message.
Sur ta proposition, j'ai transféré l'ensemble de ces lignes de programme
sur
Workbook_Open, ce qui me donne exactement le même résultat (no comment
!).
Ton idée était donc plus que recevable!
Quant à la macro que tu m'as écrite, elle fonctionne dans ce cas
IMPECCABLEMENT (no comment bis !).
A propos de ta macro, il est toujours très intéressant de voir comment
"d'autre(s)" font une macro que l'on ne sait pas soi-même appréhender ;
c'est peut-être là que l'on apprend le plus !...
Merci à toi
Antoine
' désactive le rafraîchissement de l'écran
Application.ScreenUpdating = False
' déclaration des variables du classement alphabétique
Dim a(256), j As Integer, k As Integer, n As Integer, temp
' comptage du nombre de feuilles
n = Sheets.Count
For j = 1 To n
a(j) = Sheets(j).Name
Next j
' tri des feuilles
For j = 1 To n
For k = j To n
If a(k) < a(j) Then
temp = a(k)
a(k) = a(j)
a(j) = temp
End If
Next k
Next j
' positionnement des feuilles selon la lettre
For j = 1 To n
Sheets(a(j)).Move before:=Sheets(j)
Next j
' déclaration des variables de la feuille sommaire
Dim wsh As Worksheet, i As Integer, H As Hyperlink, x As String,
R
As Range
' met la feuille Arrêt de travail type en Nième position des feuilles
Sheets("Arrêt de travail type").Move After:=Sheets(Sheets.Count)
' met la feuille Sommaire en 1ère position des feuilles
Sheets("Sommaire").Move before:=Sheets(1)
' efface toutes les celules de la feuille Sommaire
Range("A:H").Select
Selection.ClearContents
' sélectionne la cellule B1 de la feuille "Sommaire"
Sheets("Sommaire").Select
' cycle de création des transfert de valeurs
Range("B1").Select
For Each wsh In ActiveWorkbook.Sheets
i = i + 1
' créé en colonne B un lien hypertexte pour toutes les feuilles du
classeur
ActiveSheet.Hyperlinks.Add Anchor:Îlls(i + 1, 1), Address:="",
_
SubAddress:="'" & wsh.Name & "'" & "!A1", TextToDisplay:=wsh.Name
' transfert de la date/début (B9 de chaque feuille) sur la feuille
"Sommaire"
Cells(i + 1, 2) = wsh.Range("B9")
' transfert l'état "En cours/Soldé" (D4 de chaque feuille) sur la
feuille "Sommaire"
Cells(i + 1, 3) = wsh.Range("D4")
' la remplace par la date de dernière I.J. de compagnie de chaque
feuille sur la feuille "Sommaire"
If Not LCase(Cells(i + 1, 3)) Like "en cours" Then Cells(i + 1,
3)
_
Application.WorksheetFunction.Max(wsh.Range("J9:J200"))
' transfert l'état "Cadre/Non Cadre" (C3 de chaque feuille) sur la
feuille "Sommaire"
Cells(i + 1, 4) = wsh.Range("C3")
' transfert de la dernière I.J. Compagnie versée sur la feuille
"Sommaire"
Cells(i + 1, 5) = wsh.Range("N25")
' transfert du nombre de jours Compagnie (somme de P11 à P200) sur la
feuille "Sommaire"
Cells(i + 1, 6) > > Application.WorksheetFunction.Sum(wsh.Range("P11:P200"))
' transfert des I.J. totales versées /Compagnie (somme de K8 à K200)
sur la feuille "Sommaire"
Cells(i + 1, 7) > > Application.WorksheetFunction.Sum(wsh.Range("K9:K200"))
Next
' suprime le lien hyperT et les 3 cellules de droite de la 2ème ligne
For Each H In Worksheets("Sommaire").Hyperlinks
If InStr(1, H.SubAddress, "Sommaire") Then
Set R = Range(H.Parent.Address)
R = "Salariés en arrêt"
Set R = R.Offset(0, 1)
R = "Début d' arrêt"
Set R = R.Offset(0, 1)
R = "Fin d' arrêt"
Set R = R.Offset(0, 1)
R = "Statut"
Set R = R.Offset(0, 1)
R = "I.J. Cie / jour"
Set R = R.Offset(0, 1)
R = "Nb. de jours"
Set R = R.Offset(0, 1)
R = "I.J. Cie cumulées"
H.Delete
End If
Next
' met en couleur les 7 cellules de titres
Range("A2:G2").Select
With Selection.Interior
.ColorIndex = 36
.Pattern = xlSolid
End With
With Selection.Font
.Name = "Arial"
.FontStyle = "Gras"
.Size = 12
.ColorIndex = 9
End With
' supprime les 6 cellules de droite du lien hyperT de Arrêt de travail
type
For Each H In Worksheets("Sommaire").Hyperlinks
If InStr(1, H.SubAddress, "Arrêt de travail type") Then
Set R = Range(H.Parent.Address)
Set R = R.Offset(0, 1)
R = ""
Set R = R.Offset(0, 1)
R = ""
Set R = R.Offset(0, 1)
R = ""
Set R = R.Offset(0, 1)
R = ""
Set R = R.Offset(0, 1)
R = ""
Set R = R.Offset(0, 1)
R = ""
End If
Next
' applique à A2 le format de cellule de B2
Range("B2").Select
Selection.Copy
Range("A2").Select
Selection.PasteSpecial Paste:=xlFormats
Application.CutCopyMode = False
' réactive le rafraîchissement de l'écran
Application.ScreenUpdating = True
Range("A1").Select
End Sub
"Youky" <bruno.jeune@wanadoo.fr> a écrit dans le message de news:
43c15d47$0$6661$8fcfb975@news.wanadoo.fr...
Salut Antoine,
Pour l'auto_Open je n'ai pas de solutions.
Je pense qu'il est plus facile de mettre la macro en :
Private Sub Workbook_Open()
plutôt qu'en Auto_Open
Ne sachant pas ce que fait cette macro dur dur.
Là je sèche, pose la question de nouveau au forum
la manière d'utiliser Dim a(200, 20),
Cela crée un tableau à 2 dimensions
le 1er de 0 à 200 et le deuxieme 0 à 20
ce qui fait que je peux y loger 200 lignes sur 20 colonnes
ici 200 indique le nbre maxi de lignes pouvant être gardées en mémoire
bien sur que les "En cours" et pour 1 seule page
car au changement de fichier c'est réactualisé
si ligne=3 et colonne =1
a(ligne,colonne)="Antoine"
a(3,1) va renvoyer "Antoine"
le rôle du $
pas sur de moi mais en principe cela fait que la variable est
considérée
comme du texte
c'est de moins en moins utilisé, peut être que ca marche sans le $, à
essayer
Youky
"Antoine76" <awerel@mageos.com> a écrit dans le message de news:
eRosxjHFGHA.1088@tk2msftngp13.phx.gbl...
Bonsoir Youki,
Merci pour ta réponse. J'étais de sortie samedi soir, et je viens
seulement
de tester ton programme. Il fonctionne bien, à un petit détail près :
je
ne
t'ai pas précisé que la 1ère page de tous les fichiers source
sollicités
est
déjà le fruit d'une réactualisation en Auto_Open (à partir de
l'ensemble
des
autres feuilles du classeur) ; c'est ce qui me fait apparaître le
message
:
" Erreur d'exécution 1004...'Arrêt de travail Peugeot.xls' est
introuvable.
Vérifier l'orthographe du nom du classeur et la validité de
l'emplacement..."
J'ai essayé en supprimant la macro Auto_Open, cela fonctionne super.
J'ai essayé d'insérer "Application.DisplayAlerts = False" ou/et
" ActiveWorkbook.RunAutoMacros (xlAutoOpen)" ou
Workbooks(F).RunAutoMacros (xlAutoOpen), mais cela ne change rien!
Est-ce qu'il y a une solution pour le faire fonctionner en gardant
cette
Auto_Open (identique à tous les fichiers) ?
Petite question annexe, dans le code que tu as écris, je ne comprends
pas
plusieurs petites chose que tu as écrites et qui fonctionnent très
bien,
comme :
la manière d'utiliser Dim a(200, 20),
le rôle du $ dans Dir$(chem & "*.xls"),
et à quoi correspond la lettre "a" qui ne semble pas être une
variable
et
que je n'ai pas trouvé comme fonction ?
Dans tous les cas, Grand Merci pour ta contribution !
Antoine
"Youky" <bruno.jeune@wanadoo.fr> a écrit dans le message de news:
43c033a0$0$19695$8fcfb975@news.wanadoo.fr...
Bonsoir,
le seul truc qui te reste à faire, dans un fichier vierge tu inseres
un
module
et y mets cette macro et enregistre ton fichier dans le bon
répertoire
(le mm que ceux à ouvrir)sous le nom de Youky(ou à modifier dans la
macro)
J'ai pas testé en entier mais je pense que c'est pas mal
Youky
Sub test()
Dim a(200, 20)
chem = ActiveWorkbook.Path
Dim F As String
F = Dir$(chem & "*.xls")
Do Until F = ""
If F = "Youky.xls" Then GoTo saute
Workbooks.Open F
Sheets(1).Select
n = 0
For k = 3 To [C65000].End(xlUp).Row
If Cells(k, 3) = "En cours" Then
n = n + 1
a(n, 1) = [c2]
For b = 2 To 10
a(n, b) = Cells(k, b)
Next b
End If
Next
Workbooks(ActiveWorkbook.Name).Close
For nl = 1 To n
lig = lig + 1
For k = 1 To 10
Cells(lig, k) = a(nl, k)
Next k
Next nl
saute:
F = Dir$
Loop
End Sub
"Antoine76" <awerel@mageos.com> a écrit dans le message de news:
u3546Z2EGHA.1424@TK2MSFTNGP12.phx.gbl...
Bonjour à tous,
Je voudrais créer une macro, dans un fichier Excel vierge, qui
ferait
un
récapitulatif "ciblé" de tous les fichiers contenus dans un
dossier
"Clients".
Chaque fichier de ce dossier contient, toujours sur la première
page,
une
liste qui commence à partir de la ligne 3 jusqu'à n, comme
ci-après
:
A B C D
E
F G
1 ( ligne vide pour touche d'activation
de
macros
...)
2 Noms Début Fin Statut
I.J.
Cie
Jours Total
3 Bombard 13/02/04 30/09/04 NC 2,84
141
477,72
4 Dupont 11/03/03 En cours C 11,56
815 8 279,42
...
L'objectif de la macro de ce nouveau fichier, serait de
transférer,
pour
chaque fichier du dossier "Clients", toutes les lignes (à partir
de
la
3ème
ligne) de chaque 1ère page , mais dont la cellule de la colonne C
présente
la mention "En cours", et, si possible, de faire précéder ce
transfert
de
la
ligne par le contenu de la cellule $K$2 (nom du client) de la 1ère
feuille
du fichier vers la colonne A
Je ne sais pas si j'ai pu énoncer assez clairement l'objectif de
la
macro,
ainsi que la composition de chaque fichier. Si nécessaire, je peux
joindre
le fichier en cjoint...
Je ne sais pas comment faire pour créer une telle macro, et si il
est
possible de le faire sans ouvrir à chaque fois le fichier ?
Merci de vos conseils
Antoine
Trés belle macro, superbe, et quand tout fonctionne la magie fait son
oeuvre.
Cela m'a fait plaisir d'avoir réussit ta demande.
Youky
A+
"Antoine76" a écrit dans le message de news:Rebonsoir Youki
En Auto_Open, j'ai une "mise à jour" de "l'état d'avancement de dossier"
correspondant à chaque feuille (transfert du lien H pour un accès
rapide,
et
recopie des cellules contenant différentes valeur caractéristiques de
l'évolution de chaque dossier) ; Pour plus d'Info , j'ai déposé les
lignes
de code (réalisé pour une bonne part grace à MFPE) à la fin de ce
message.
Sur ta proposition, j'ai transféré l'ensemble de ces lignes de programme
sur
Workbook_Open, ce qui me donne exactement le même résultat (no comment
!).
Ton idée était donc plus que recevable!
Quant à la macro que tu m'as écrite, elle fonctionne dans ce cas
IMPECCABLEMENT (no comment bis !).
A propos de ta macro, il est toujours très intéressant de voir comment
"d'autre(s)" font une macro que l'on ne sait pas soi-même appréhender ;
c'est peut-être là que l'on apprend le plus !...
Merci à toi
Antoine
' désactive le rafraîchissement de l'écran
Application.ScreenUpdating = False
' déclaration des variables du classement alphabétique
Dim a(256), j As Integer, k As Integer, n As Integer, temp
' comptage du nombre de feuilles
n = Sheets.Count
For j = 1 To n
a(j) = Sheets(j).Name
Next j
' tri des feuilles
For j = 1 To n
For k = j To n
If a(k) < a(j) Then
temp = a(k)
a(k) = a(j)
a(j) = temp
End If
Next k
Next j
' positionnement des feuilles selon la lettre
For j = 1 To n
Sheets(a(j)).Move before:=Sheets(j)
Next j
' déclaration des variables de la feuille sommaire
Dim wsh As Worksheet, i As Integer, H As Hyperlink, x As String,
R
As Range
' met la feuille Arrêt de travail type en Nième position des feuilles
Sheets("Arrêt de travail type").Move After:=Sheets(Sheets.Count)
' met la feuille Sommaire en 1ère position des feuilles
Sheets("Sommaire").Move before:=Sheets(1)
' efface toutes les celules de la feuille Sommaire
Range("A:H").Select
Selection.ClearContents
' sélectionne la cellule B1 de la feuille "Sommaire"
Sheets("Sommaire").Select
' cycle de création des transfert de valeurs
Range("B1").Select
For Each wsh In ActiveWorkbook.Sheets
i = i + 1
' créé en colonne B un lien hypertexte pour toutes les feuilles du
classeur
ActiveSheet.Hyperlinks.Add Anchor:Îlls(i + 1, 1), Address:="",
_
SubAddress:="'" & wsh.Name & "'" & "!A1", TextToDisplay:=wsh.Name
' transfert de la date/début (B9 de chaque feuille) sur la feuille
"Sommaire"
Cells(i + 1, 2) = wsh.Range("B9")
' transfert l'état "En cours/Soldé" (D4 de chaque feuille) sur la
feuille "Sommaire"
Cells(i + 1, 3) = wsh.Range("D4")
' la remplace par la date de dernière I.J. de compagnie de chaque
feuille sur la feuille "Sommaire"
If Not LCase(Cells(i + 1, 3)) Like "en cours" Then Cells(i + 1,
3)
_
Application.WorksheetFunction.Max(wsh.Range("J9:J200"))
' transfert l'état "Cadre/Non Cadre" (C3 de chaque feuille) sur la
feuille "Sommaire"
Cells(i + 1, 4) = wsh.Range("C3")
' transfert de la dernière I.J. Compagnie versée sur la feuille
"Sommaire"
Cells(i + 1, 5) = wsh.Range("N25")
' transfert du nombre de jours Compagnie (somme de P11 à P200) sur la
feuille "Sommaire"
Cells(i + 1, 6) > > Application.WorksheetFunction.Sum(wsh.Range("P11:P200"))
' transfert des I.J. totales versées /Compagnie (somme de K8 à K200)
sur la feuille "Sommaire"
Cells(i + 1, 7) > > Application.WorksheetFunction.Sum(wsh.Range("K9:K200"))
Next
' suprime le lien hyperT et les 3 cellules de droite de la 2ème ligne
For Each H In Worksheets("Sommaire").Hyperlinks
If InStr(1, H.SubAddress, "Sommaire") Then
Set R = Range(H.Parent.Address)
R = "Salariés en arrêt"
Set R = R.Offset(0, 1)
R = "Début d' arrêt"
Set R = R.Offset(0, 1)
R = "Fin d' arrêt"
Set R = R.Offset(0, 1)
R = "Statut"
Set R = R.Offset(0, 1)
R = "I.J. Cie / jour"
Set R = R.Offset(0, 1)
R = "Nb. de jours"
Set R = R.Offset(0, 1)
R = "I.J. Cie cumulées"
H.Delete
End If
Next
' met en couleur les 7 cellules de titres
Range("A2:G2").Select
With Selection.Interior
.ColorIndex = 36
.Pattern = xlSolid
End With
With Selection.Font
.Name = "Arial"
.FontStyle = "Gras"
.Size = 12
.ColorIndex = 9
End With
' supprime les 6 cellules de droite du lien hyperT de Arrêt de travail
type
For Each H In Worksheets("Sommaire").Hyperlinks
If InStr(1, H.SubAddress, "Arrêt de travail type") Then
Set R = Range(H.Parent.Address)
Set R = R.Offset(0, 1)
R = ""
Set R = R.Offset(0, 1)
R = ""
Set R = R.Offset(0, 1)
R = ""
Set R = R.Offset(0, 1)
R = ""
Set R = R.Offset(0, 1)
R = ""
Set R = R.Offset(0, 1)
R = ""
End If
Next
' applique à A2 le format de cellule de B2
Range("B2").Select
Selection.Copy
Range("A2").Select
Selection.PasteSpecial Paste:=xlFormats
Application.CutCopyMode = False
' réactive le rafraîchissement de l'écran
Application.ScreenUpdating = True
Range("A1").Select
End Sub
"Youky" a écrit dans le message de news:
43c15d47$0$6661$Salut Antoine,
Pour l'auto_Open je n'ai pas de solutions.
Je pense qu'il est plus facile de mettre la macro en :
Private Sub Workbook_Open()
plutôt qu'en Auto_Open
Ne sachant pas ce que fait cette macro dur dur.
Là je sèche, pose la question de nouveau au forumla manière d'utiliser Dim a(200, 20),
Cela crée un tableau à 2 dimensions
le 1er de 0 à 200 et le deuxieme 0 à 20
ce qui fait que je peux y loger 200 lignes sur 20 colonnes
ici 200 indique le nbre maxi de lignes pouvant être gardées en mémoire
bien sur que les "En cours" et pour 1 seule page
car au changement de fichier c'est réactualisé
si ligne=3 et colonne =1
a(ligne,colonne)="Antoine"
a(3,1) va renvoyer "Antoine"le rôle du $
pas sur de moi mais en principe cela fait que la variable est
considérée
comme du texte
c'est de moins en moins utilisé, peut être que ca marche sans le $, à
essayer
Youky
"Antoine76" a écrit dans le message de news:Bonsoir Youki,
Merci pour ta réponse. J'étais de sortie samedi soir, et je viens
seulement
de tester ton programme. Il fonctionne bien, à un petit détail près :
je
ne
t'ai pas précisé que la 1ère page de tous les fichiers source
sollicités
est
déjà le fruit d'une réactualisation en Auto_Open (à partir de
l'ensemble
des
autres feuilles du classeur) ; c'est ce qui me fait apparaître le
message:
" Erreur d'exécution 1004...'Arrêt de travail Peugeot.xls' est
introuvable.
Vérifier l'orthographe du nom du classeur et la validité de
l'emplacement..."
J'ai essayé en supprimant la macro Auto_Open, cela fonctionne super.
J'ai essayé d'insérer "Application.DisplayAlerts = False" ou/et
" ActiveWorkbook.RunAutoMacros (xlAutoOpen)" ou
Workbooks(F).RunAutoMacros (xlAutoOpen), mais cela ne change rien!
Est-ce qu'il y a une solution pour le faire fonctionner en gardant
cette
Auto_Open (identique à tous les fichiers) ?
Petite question annexe, dans le code que tu as écris, je ne comprends
pasplusieurs petites chose que tu as écrites et qui fonctionnent très
bien,
comme :
la manière d'utiliser Dim a(200, 20),
le rôle du $ dans Dir$(chem & "*.xls"),
et à quoi correspond la lettre "a" qui ne semble pas être une
variable
etque je n'ai pas trouvé comme fonction ?
Dans tous les cas, Grand Merci pour ta contribution !
Antoine
"Youky" a écrit dans le message de news:
43c033a0$0$19695$Bonsoir,
le seul truc qui te reste à faire, dans un fichier vierge tu inseres
un
module
et y mets cette macro et enregistre ton fichier dans le bon
répertoire
(le mm que ceux à ouvrir)sous le nom de Youky(ou à modifier dans la
macro)
J'ai pas testé en entier mais je pense que c'est pas mal
Youky
Sub test()
Dim a(200, 20)
chem = ActiveWorkbook.Path
Dim F As String
F = Dir$(chem & "*.xls")
Do Until F = ""
If F = "Youky.xls" Then GoTo saute
Workbooks.Open F
Sheets(1).Select
n = 0
For k = 3 To [C65000].End(xlUp).Row
If Cells(k, 3) = "En cours" Then
n = n + 1
a(n, 1) = [c2]
For b = 2 To 10
a(n, b) = Cells(k, b)
Next b
End If
Next
Workbooks(ActiveWorkbook.Name).Close
For nl = 1 To n
lig = lig + 1
For k = 1 To 10
Cells(lig, k) = a(nl, k)
Next k
Next nl
saute:
F = Dir$
Loop
End Sub
"Antoine76" a écrit dans le message de news:Bonjour à tous,
Je voudrais créer une macro, dans un fichier Excel vierge, qui
ferait
un
récapitulatif "ciblé" de tous les fichiers contenus dans un
dossier
"Clients".
Chaque fichier de ce dossier contient, toujours sur la première
page,
uneliste qui commence à partir de la ligne 3 jusqu'à n, comme
ci-après
:
A B C D
EF G
1 ( ligne vide pour touche d'activation
de
macros
...)
2 Noms Début Fin Statut
I.J.
Cie
Jours Total
3 Bombard 13/02/04 30/09/04 NC 2,84
141477,72
4 Dupont 11/03/03 En cours C 11,56
815 8 279,42
...
L'objectif de la macro de ce nouveau fichier, serait de
transférer,
pour
chaque fichier du dossier "Clients", toutes les lignes (à partir
de
la3ème
ligne) de chaque 1ère page , mais dont la cellule de la colonne C
présentela mention "En cours", et, si possible, de faire précéder ce
transfertdela
ligne par le contenu de la cellule $K$2 (nom du client) de la 1ère
feuilledu fichier vers la colonne A
Je ne sais pas si j'ai pu énoncer assez clairement l'objectif de
la
macro,ainsi que la composition de chaque fichier. Si nécessaire, je peux
joindrele fichier en cjoint...
Je ne sais pas comment faire pour créer une telle macro, et si il
est
possible de le faire sans ouvrir à chaque fois le fichier ?
Merci de vos conseils
Antoine
bonsoir Youky !
Je ne sais plus trop que dire !
Ainsi que je te l'ai évoqué, le programme que j'ai fait avec la
collaboration (majoritaire!) de JB fonctionne OK;
Celui que tu m'a fait aussi (notamment après l'adoption dans Workbook
_Open)
!
Le problème ?
C'est que quand je vais au fond de l'intégration des macros dans les
fichiers, la corde casse !
Et je ne comprends plus rien ! Est-ce dû à la déclaration des variables,
au
nom des fichiers qui ont un trait d'union("Arrêt de travail - jean-louis
DAVID"), à.... ? J'ai essayé de tout triturer dans tous les sens, rien n'y
fait ! Je suis en panne d'idée :-((((
La mort dans l'âme, je me résigne à livrer de manière brute, en 1er le
fichier satellite, avec macro (qui doit être multiple...), en 2ème le
fichier de centralisation de l'évolution des données :
N° 1 : http://cjoint.com/?bjwdXuxpKW
N° 2 : http://cjoint.com/?bjwf56LCvu
Je ne sais plus quoi ajouter, si ce n'est un certain désarroi, qui
n'exclut
pas pour autant la volonté de comprendre pourquoi, comment !
Antoine
"Youky" a écrit dans le message de news:
43c22a42$0$29210$Trés belle macro, superbe, et quand tout fonctionne la magie fait son
oeuvre.
Cela m'a fait plaisir d'avoir réussit ta demande.
Youky
A+
"Antoine76" a écrit dans le message de news:Rebonsoir Youki
En Auto_Open, j'ai une "mise à jour" de "l'état d'avancement de
dossier"
correspondant à chaque feuille (transfert du lien H pour un accès
rapide,et
recopie des cellules contenant différentes valeur caractéristiques de
l'évolution de chaque dossier) ; Pour plus d'Info , j'ai déposé les
lignesde code (réalisé pour une bonne part grace à MFPE) à la fin de ce
message.Sur ta proposition, j'ai transféré l'ensemble de ces lignes de
programme
sur
Workbook_Open, ce qui me donne exactement le même résultat (no comment
!).Ton idée était donc plus que recevable!
Quant à la macro que tu m'as écrite, elle fonctionne dans ce cas
IMPECCABLEMENT (no comment bis !).
A propos de ta macro, il est toujours très intéressant de voir comment
"d'autre(s)" font une macro que l'on ne sait pas soi-même appréhender ;
c'est peut-être là que l'on apprend le plus !...
Merci à toi
Antoine
' désactive le rafraîchissement de l'écran
Application.ScreenUpdating = False
' déclaration des variables du classement alphabétique
Dim a(256), j As Integer, k As Integer, n As Integer, temp
' comptage du nombre de feuilles
n = Sheets.Count
For j = 1 To n
a(j) = Sheets(j).Name
Next j
' tri des feuilles
For j = 1 To n
For k = j To n
If a(k) < a(j) Then
temp = a(k)
a(k) = a(j)
a(j) = temp
End If
Next k
Next j
' positionnement des feuilles selon la lettre
For j = 1 To n
Sheets(a(j)).Move before:=Sheets(j)
Next j
' déclaration des variables de la feuille sommaire
Dim wsh As Worksheet, i As Integer, H As Hyperlink, x As String,
RAs Range
' met la feuille Arrêt de travail type en Nième position des
feuilles
Sheets("Arrêt de travail type").Move After:=Sheets(Sheets.Count)
' met la feuille Sommaire en 1ère position des feuilles
Sheets("Sommaire").Move before:=Sheets(1)
' efface toutes les celules de la feuille Sommaire
Range("A:H").Select
Selection.ClearContents
' sélectionne la cellule B1 de la feuille "Sommaire"
Sheets("Sommaire").Select
' cycle de création des transfert de valeurs
Range("B1").Select
For Each wsh In ActiveWorkbook.Sheets
i = i + 1
' créé en colonne B un lien hypertexte pour toutes les feuilles du
classeur
ActiveSheet.Hyperlinks.Add Anchor:Îlls(i + 1, 1), Address:="",
_SubAddress:="'" & wsh.Name & "'" & "!A1",
TextToDisplay:=wsh.Name
' transfert de la date/début (B9 de chaque feuille) sur la feuille
"Sommaire"
Cells(i + 1, 2) = wsh.Range("B9")
' transfert l'état "En cours/Soldé" (D4 de chaque feuille) sur la
feuille "Sommaire"
Cells(i + 1, 3) = wsh.Range("D4")
' la remplace par la date de dernière I.J. de compagnie de chaque
feuille sur la feuille "Sommaire"
If Not LCase(Cells(i + 1, 3)) Like "en cours" Then Cells(i + 1,
3)_
Application.WorksheetFunction.Max(wsh.Range("J9:J200"))
' transfert l'état "Cadre/Non Cadre" (C3 de chaque feuille) sur la
feuille "Sommaire"
Cells(i + 1, 4) = wsh.Range("C3")
' transfert de la dernière I.J. Compagnie versée sur la feuille
"Sommaire"
Cells(i + 1, 5) = wsh.Range("N25")
' transfert du nombre de jours Compagnie (somme de P11 à P200) sur
la
feuille "Sommaire"
Cells(i + 1, 6) >> > Application.WorksheetFunction.Sum(wsh.Range("P11:P200"))
' transfert des I.J. totales versées /Compagnie (somme de K8 à
K200)
sur la feuille "Sommaire"
Cells(i + 1, 7) >> > Application.WorksheetFunction.Sum(wsh.Range("K9:K200"))
Next
' suprime le lien hyperT et les 3 cellules de droite de la 2ème
ligne
For Each H In Worksheets("Sommaire").Hyperlinks
If InStr(1, H.SubAddress, "Sommaire") Then
Set R = Range(H.Parent.Address)
R = "Salariés en arrêt"
Set R = R.Offset(0, 1)
R = "Début d' arrêt"
Set R = R.Offset(0, 1)
R = "Fin d' arrêt"
Set R = R.Offset(0, 1)
R = "Statut"
Set R = R.Offset(0, 1)
R = "I.J. Cie / jour"
Set R = R.Offset(0, 1)
R = "Nb. de jours"
Set R = R.Offset(0, 1)
R = "I.J. Cie cumulées"
H.Delete
End If
Next
' met en couleur les 7 cellules de titres
Range("A2:G2").Select
With Selection.Interior
.ColorIndex = 36
.Pattern = xlSolid
End With
With Selection.Font
.Name = "Arial"
.FontStyle = "Gras"
.Size = 12
.ColorIndex = 9
End With
' supprime les 6 cellules de droite du lien hyperT de Arrêt de
travail
type
For Each H In Worksheets("Sommaire").Hyperlinks
If InStr(1, H.SubAddress, "Arrêt de travail type") Then
Set R = Range(H.Parent.Address)
Set R = R.Offset(0, 1)
R = ""
Set R = R.Offset(0, 1)
R = ""
Set R = R.Offset(0, 1)
R = ""
Set R = R.Offset(0, 1)
R = ""
Set R = R.Offset(0, 1)
R = ""
Set R = R.Offset(0, 1)
R = ""
End If
Next
' applique à A2 le format de cellule de B2
Range("B2").Select
Selection.Copy
Range("A2").Select
Selection.PasteSpecial Paste:=xlFormats
Application.CutCopyMode = False
' réactive le rafraîchissement de l'écran
Application.ScreenUpdating = True
Range("A1").Select
End Sub
"Youky" a écrit dans le message de news:
43c15d47$0$6661$Salut Antoine,
Pour l'auto_Open je n'ai pas de solutions.
Je pense qu'il est plus facile de mettre la macro en :
Private Sub Workbook_Open()
plutôt qu'en Auto_Open
Ne sachant pas ce que fait cette macro dur dur.
Là je sèche, pose la question de nouveau au forumla manière d'utiliser Dim a(200, 20),
Cela crée un tableau à 2 dimensions
le 1er de 0 à 200 et le deuxieme 0 à 20
ce qui fait que je peux y loger 200 lignes sur 20 colonnes
ici 200 indique le nbre maxi de lignes pouvant être gardées en mémoire
bien sur que les "En cours" et pour 1 seule page
car au changement de fichier c'est réactualisé
si ligne=3 et colonne =1
a(ligne,colonne)="Antoine"
a(3,1) va renvoyer "Antoine"le rôle du $
pas sur de moi mais en principe cela fait que la variable est
considéréecomme du texte
c'est de moins en moins utilisé, peut être que ca marche sans le $, à
essayer
Youky
"Antoine76" a écrit dans le message de news:Bonsoir Youki,
Merci pour ta réponse. J'étais de sortie samedi soir, et je viens
seulement
de tester ton programme. Il fonctionne bien, à un petit détail près
:
je
ne
t'ai pas précisé que la 1ère page de tous les fichiers source
sollicités
est
déjà le fruit d'une réactualisation en Auto_Open (à partir de
l'ensemble
des
autres feuilles du classeur) ; c'est ce qui me fait apparaître le
message:
" Erreur d'exécution 1004...'Arrêt de travail Peugeot.xls' est
introuvable.
Vérifier l'orthographe du nom du classeur et la validité de
l'emplacement..."
J'ai essayé en supprimant la macro Auto_Open, cela fonctionne super.
J'ai essayé d'insérer "Application.DisplayAlerts = False" ou/et
" ActiveWorkbook.RunAutoMacros (xlAutoOpen)" ou
Workbooks(F).RunAutoMacros (xlAutoOpen), mais cela ne change rien!
Est-ce qu'il y a une solution pour le faire fonctionner en gardant
cette
Auto_Open (identique à tous les fichiers) ?
Petite question annexe, dans le code que tu as écris, je ne
comprends
pasplusieurs petites chose que tu as écrites et qui fonctionnent très
bien,
comme :
la manière d'utiliser Dim a(200, 20),
le rôle du $ dans Dir$(chem & "*.xls"),
et à quoi correspond la lettre "a" qui ne semble pas être une
variableetque je n'ai pas trouvé comme fonction ?
Dans tous les cas, Grand Merci pour ta contribution !
Antoine
"Youky" a écrit dans le message de news:
43c033a0$0$19695$Bonsoir,
le seul truc qui te reste à faire, dans un fichier vierge tu
inseres
un
module
et y mets cette macro et enregistre ton fichier dans le bon
répertoire(le mm que ceux à ouvrir)sous le nom de Youky(ou à modifier dans la
macro)
J'ai pas testé en entier mais je pense que c'est pas mal
Youky
Sub test()
Dim a(200, 20)
chem = ActiveWorkbook.Path
Dim F As String
F = Dir$(chem & "*.xls")
Do Until F = ""
If F = "Youky.xls" Then GoTo saute
Workbooks.Open F
Sheets(1).Select
n = 0
For k = 3 To [C65000].End(xlUp).Row
If Cells(k, 3) = "En cours" Then
n = n + 1
a(n, 1) = [c2]
For b = 2 To 10
a(n, b) = Cells(k, b)
Next b
End If
Next
Workbooks(ActiveWorkbook.Name).Close
For nl = 1 To n
lig = lig + 1
For k = 1 To 10
Cells(lig, k) = a(nl, k)
Next k
Next nl
saute:
F = Dir$
Loop
End Sub
"Antoine76" a écrit dans le message de news:Bonjour à tous,
Je voudrais créer une macro, dans un fichier Excel vierge, qui
ferait
un
récapitulatif "ciblé" de tous les fichiers contenus dans un
dossier"Clients".
Chaque fichier de ce dossier contient, toujours sur la première
page,
uneliste qui commence à partir de la ligne 3 jusqu'à n, comme
ci-après:
A B C D
EF G
1 ( ligne vide pour touche
d'activation
de
macros
...)
2 Noms Début Fin Statut
I.J.Cie
Jours Total
3 Bombard 13/02/04 30/09/04 NC 2,84
141477,72
4 Dupont 11/03/03 En cours C 11,56
815 8 279,42
...
L'objectif de la macro de ce nouveau fichier, serait de
transférer,pour
chaque fichier du dossier "Clients", toutes les lignes (à partir
dela3ème
ligne) de chaque 1ère page , mais dont la cellule de la colonne C
présentela mention "En cours", et, si possible, de faire précéder ce
transfertdela
ligne par le contenu de la cellule $K$2 (nom du client) de la
1ère
feuilledu fichier vers la colonne A
Je ne sais pas si j'ai pu énoncer assez clairement l'objectif de
lamacro,ainsi que la composition de chaque fichier. Si nécessaire, je
peux
joindrele fichier en cjoint...
Je ne sais pas comment faire pour créer une telle macro, et si il
est
possible de le faire sans ouvrir à chaque fois le fichier ?
Merci de vos conseils
Antoine
bonsoir Youky !
Je ne sais plus trop que dire !
Ainsi que je te l'ai évoqué, le programme que j'ai fait avec la
collaboration (majoritaire!) de JB fonctionne OK;
Celui que tu m'a fait aussi (notamment après l'adoption dans Workbook
_Open)
!
Le problème ?
C'est que quand je vais au fond de l'intégration des macros dans les
fichiers, la corde casse !
Et je ne comprends plus rien ! Est-ce dû à la déclaration des variables,
au
nom des fichiers qui ont un trait d'union("Arrêt de travail - jean-louis
DAVID"), à.... ? J'ai essayé de tout triturer dans tous les sens, rien n'y
fait ! Je suis en panne d'idée :-((((
La mort dans l'âme, je me résigne à livrer de manière brute, en 1er le
fichier satellite, avec macro (qui doit être multiple...), en 2ème le
fichier de centralisation de l'évolution des données :
N° 1 : http://cjoint.com/?bjwdXuxpKW
N° 2 : http://cjoint.com/?bjwf56LCvu
Je ne sais plus quoi ajouter, si ce n'est un certain désarroi, qui
n'exclut
pas pour autant la volonté de comprendre pourquoi, comment !
Antoine
"Youky" <bruno.jeune@wanadoo.fr> a écrit dans le message de news:
43c22a42$0$29210$8fcfb975@news.wanadoo.fr...
Trés belle macro, superbe, et quand tout fonctionne la magie fait son
oeuvre.
Cela m'a fait plaisir d'avoir réussit ta demande.
Youky
A+
"Antoine76" <awerel@mageos.com> a écrit dans le message de news:
unZ6bFJFGHA.2012@TK2MSFTNGP14.phx.gbl...
Rebonsoir Youki
En Auto_Open, j'ai une "mise à jour" de "l'état d'avancement de
dossier"
correspondant à chaque feuille (transfert du lien H pour un accès
rapide,
et
recopie des cellules contenant différentes valeur caractéristiques de
l'évolution de chaque dossier) ; Pour plus d'Info , j'ai déposé les
lignes
de code (réalisé pour une bonne part grace à MFPE) à la fin de ce
message.
Sur ta proposition, j'ai transféré l'ensemble de ces lignes de
programme
sur
Workbook_Open, ce qui me donne exactement le même résultat (no comment
!).
Ton idée était donc plus que recevable!
Quant à la macro que tu m'as écrite, elle fonctionne dans ce cas
IMPECCABLEMENT (no comment bis !).
A propos de ta macro, il est toujours très intéressant de voir comment
"d'autre(s)" font une macro que l'on ne sait pas soi-même appréhender ;
c'est peut-être là que l'on apprend le plus !...
Merci à toi
Antoine
' désactive le rafraîchissement de l'écran
Application.ScreenUpdating = False
' déclaration des variables du classement alphabétique
Dim a(256), j As Integer, k As Integer, n As Integer, temp
' comptage du nombre de feuilles
n = Sheets.Count
For j = 1 To n
a(j) = Sheets(j).Name
Next j
' tri des feuilles
For j = 1 To n
For k = j To n
If a(k) < a(j) Then
temp = a(k)
a(k) = a(j)
a(j) = temp
End If
Next k
Next j
' positionnement des feuilles selon la lettre
For j = 1 To n
Sheets(a(j)).Move before:=Sheets(j)
Next j
' déclaration des variables de la feuille sommaire
Dim wsh As Worksheet, i As Integer, H As Hyperlink, x As String,
R
As Range
' met la feuille Arrêt de travail type en Nième position des
feuilles
Sheets("Arrêt de travail type").Move After:=Sheets(Sheets.Count)
' met la feuille Sommaire en 1ère position des feuilles
Sheets("Sommaire").Move before:=Sheets(1)
' efface toutes les celules de la feuille Sommaire
Range("A:H").Select
Selection.ClearContents
' sélectionne la cellule B1 de la feuille "Sommaire"
Sheets("Sommaire").Select
' cycle de création des transfert de valeurs
Range("B1").Select
For Each wsh In ActiveWorkbook.Sheets
i = i + 1
' créé en colonne B un lien hypertexte pour toutes les feuilles du
classeur
ActiveSheet.Hyperlinks.Add Anchor:Îlls(i + 1, 1), Address:="",
_
SubAddress:="'" & wsh.Name & "'" & "!A1",
TextToDisplay:=wsh.Name
' transfert de la date/début (B9 de chaque feuille) sur la feuille
"Sommaire"
Cells(i + 1, 2) = wsh.Range("B9")
' transfert l'état "En cours/Soldé" (D4 de chaque feuille) sur la
feuille "Sommaire"
Cells(i + 1, 3) = wsh.Range("D4")
' la remplace par la date de dernière I.J. de compagnie de chaque
feuille sur la feuille "Sommaire"
If Not LCase(Cells(i + 1, 3)) Like "en cours" Then Cells(i + 1,
3)
_
Application.WorksheetFunction.Max(wsh.Range("J9:J200"))
' transfert l'état "Cadre/Non Cadre" (C3 de chaque feuille) sur la
feuille "Sommaire"
Cells(i + 1, 4) = wsh.Range("C3")
' transfert de la dernière I.J. Compagnie versée sur la feuille
"Sommaire"
Cells(i + 1, 5) = wsh.Range("N25")
' transfert du nombre de jours Compagnie (somme de P11 à P200) sur
la
feuille "Sommaire"
Cells(i + 1, 6) >> > Application.WorksheetFunction.Sum(wsh.Range("P11:P200"))
' transfert des I.J. totales versées /Compagnie (somme de K8 à
K200)
sur la feuille "Sommaire"
Cells(i + 1, 7) >> > Application.WorksheetFunction.Sum(wsh.Range("K9:K200"))
Next
' suprime le lien hyperT et les 3 cellules de droite de la 2ème
ligne
For Each H In Worksheets("Sommaire").Hyperlinks
If InStr(1, H.SubAddress, "Sommaire") Then
Set R = Range(H.Parent.Address)
R = "Salariés en arrêt"
Set R = R.Offset(0, 1)
R = "Début d' arrêt"
Set R = R.Offset(0, 1)
R = "Fin d' arrêt"
Set R = R.Offset(0, 1)
R = "Statut"
Set R = R.Offset(0, 1)
R = "I.J. Cie / jour"
Set R = R.Offset(0, 1)
R = "Nb. de jours"
Set R = R.Offset(0, 1)
R = "I.J. Cie cumulées"
H.Delete
End If
Next
' met en couleur les 7 cellules de titres
Range("A2:G2").Select
With Selection.Interior
.ColorIndex = 36
.Pattern = xlSolid
End With
With Selection.Font
.Name = "Arial"
.FontStyle = "Gras"
.Size = 12
.ColorIndex = 9
End With
' supprime les 6 cellules de droite du lien hyperT de Arrêt de
travail
type
For Each H In Worksheets("Sommaire").Hyperlinks
If InStr(1, H.SubAddress, "Arrêt de travail type") Then
Set R = Range(H.Parent.Address)
Set R = R.Offset(0, 1)
R = ""
Set R = R.Offset(0, 1)
R = ""
Set R = R.Offset(0, 1)
R = ""
Set R = R.Offset(0, 1)
R = ""
Set R = R.Offset(0, 1)
R = ""
Set R = R.Offset(0, 1)
R = ""
End If
Next
' applique à A2 le format de cellule de B2
Range("B2").Select
Selection.Copy
Range("A2").Select
Selection.PasteSpecial Paste:=xlFormats
Application.CutCopyMode = False
' réactive le rafraîchissement de l'écran
Application.ScreenUpdating = True
Range("A1").Select
End Sub
"Youky" <bruno.jeune@wanadoo.fr> a écrit dans le message de news:
43c15d47$0$6661$8fcfb975@news.wanadoo.fr...
Salut Antoine,
Pour l'auto_Open je n'ai pas de solutions.
Je pense qu'il est plus facile de mettre la macro en :
Private Sub Workbook_Open()
plutôt qu'en Auto_Open
Ne sachant pas ce que fait cette macro dur dur.
Là je sèche, pose la question de nouveau au forum
la manière d'utiliser Dim a(200, 20),
Cela crée un tableau à 2 dimensions
le 1er de 0 à 200 et le deuxieme 0 à 20
ce qui fait que je peux y loger 200 lignes sur 20 colonnes
ici 200 indique le nbre maxi de lignes pouvant être gardées en mémoire
bien sur que les "En cours" et pour 1 seule page
car au changement de fichier c'est réactualisé
si ligne=3 et colonne =1
a(ligne,colonne)="Antoine"
a(3,1) va renvoyer "Antoine"
le rôle du $
pas sur de moi mais en principe cela fait que la variable est
considérée
comme du texte
c'est de moins en moins utilisé, peut être que ca marche sans le $, à
essayer
Youky
"Antoine76" <awerel@mageos.com> a écrit dans le message de news:
eRosxjHFGHA.1088@tk2msftngp13.phx.gbl...
Bonsoir Youki,
Merci pour ta réponse. J'étais de sortie samedi soir, et je viens
seulement
de tester ton programme. Il fonctionne bien, à un petit détail près
:
je
ne
t'ai pas précisé que la 1ère page de tous les fichiers source
sollicités
est
déjà le fruit d'une réactualisation en Auto_Open (à partir de
l'ensemble
des
autres feuilles du classeur) ; c'est ce qui me fait apparaître le
message
:
" Erreur d'exécution 1004...'Arrêt de travail Peugeot.xls' est
introuvable.
Vérifier l'orthographe du nom du classeur et la validité de
l'emplacement..."
J'ai essayé en supprimant la macro Auto_Open, cela fonctionne super.
J'ai essayé d'insérer "Application.DisplayAlerts = False" ou/et
" ActiveWorkbook.RunAutoMacros (xlAutoOpen)" ou
Workbooks(F).RunAutoMacros (xlAutoOpen), mais cela ne change rien!
Est-ce qu'il y a une solution pour le faire fonctionner en gardant
cette
Auto_Open (identique à tous les fichiers) ?
Petite question annexe, dans le code que tu as écris, je ne
comprends
pas
plusieurs petites chose que tu as écrites et qui fonctionnent très
bien,
comme :
la manière d'utiliser Dim a(200, 20),
le rôle du $ dans Dir$(chem & "*.xls"),
et à quoi correspond la lettre "a" qui ne semble pas être une
variable
et
que je n'ai pas trouvé comme fonction ?
Dans tous les cas, Grand Merci pour ta contribution !
Antoine
"Youky" <bruno.jeune@wanadoo.fr> a écrit dans le message de news:
43c033a0$0$19695$8fcfb975@news.wanadoo.fr...
Bonsoir,
le seul truc qui te reste à faire, dans un fichier vierge tu
inseres
un
module
et y mets cette macro et enregistre ton fichier dans le bon
répertoire
(le mm que ceux à ouvrir)sous le nom de Youky(ou à modifier dans la
macro)
J'ai pas testé en entier mais je pense que c'est pas mal
Youky
Sub test()
Dim a(200, 20)
chem = ActiveWorkbook.Path
Dim F As String
F = Dir$(chem & "*.xls")
Do Until F = ""
If F = "Youky.xls" Then GoTo saute
Workbooks.Open F
Sheets(1).Select
n = 0
For k = 3 To [C65000].End(xlUp).Row
If Cells(k, 3) = "En cours" Then
n = n + 1
a(n, 1) = [c2]
For b = 2 To 10
a(n, b) = Cells(k, b)
Next b
End If
Next
Workbooks(ActiveWorkbook.Name).Close
For nl = 1 To n
lig = lig + 1
For k = 1 To 10
Cells(lig, k) = a(nl, k)
Next k
Next nl
saute:
F = Dir$
Loop
End Sub
"Antoine76" <awerel@mageos.com> a écrit dans le message de news:
u3546Z2EGHA.1424@TK2MSFTNGP12.phx.gbl...
Bonjour à tous,
Je voudrais créer une macro, dans un fichier Excel vierge, qui
ferait
un
récapitulatif "ciblé" de tous les fichiers contenus dans un
dossier
"Clients".
Chaque fichier de ce dossier contient, toujours sur la première
page,
une
liste qui commence à partir de la ligne 3 jusqu'à n, comme
ci-après
:
A B C D
E
F G
1 ( ligne vide pour touche
d'activation
de
macros
...)
2 Noms Début Fin Statut
I.J.
Cie
Jours Total
3 Bombard 13/02/04 30/09/04 NC 2,84
141
477,72
4 Dupont 11/03/03 En cours C 11,56
815 8 279,42
...
L'objectif de la macro de ce nouveau fichier, serait de
transférer,
pour
chaque fichier du dossier "Clients", toutes les lignes (à partir
de
la
3ème
ligne) de chaque 1ère page , mais dont la cellule de la colonne C
présente
la mention "En cours", et, si possible, de faire précéder ce
transfert
de
la
ligne par le contenu de la cellule $K$2 (nom du client) de la
1ère
feuille
du fichier vers la colonne A
Je ne sais pas si j'ai pu énoncer assez clairement l'objectif de
la
macro,
ainsi que la composition de chaque fichier. Si nécessaire, je
peux
joindre
le fichier en cjoint...
Je ne sais pas comment faire pour créer une telle macro, et si il
est
possible de le faire sans ouvrir à chaque fois le fichier ?
Merci de vos conseils
Antoine
bonsoir Youky !
Je ne sais plus trop que dire !
Ainsi que je te l'ai évoqué, le programme que j'ai fait avec la
collaboration (majoritaire!) de JB fonctionne OK;
Celui que tu m'a fait aussi (notamment après l'adoption dans Workbook
_Open)
!
Le problème ?
C'est que quand je vais au fond de l'intégration des macros dans les
fichiers, la corde casse !
Et je ne comprends plus rien ! Est-ce dû à la déclaration des variables,
au
nom des fichiers qui ont un trait d'union("Arrêt de travail - jean-louis
DAVID"), à.... ? J'ai essayé de tout triturer dans tous les sens, rien n'y
fait ! Je suis en panne d'idée :-((((
La mort dans l'âme, je me résigne à livrer de manière brute, en 1er le
fichier satellite, avec macro (qui doit être multiple...), en 2ème le
fichier de centralisation de l'évolution des données :
N° 1 : http://cjoint.com/?bjwdXuxpKW
N° 2 : http://cjoint.com/?bjwf56LCvu
Je ne sais plus quoi ajouter, si ce n'est un certain désarroi, qui
n'exclut
pas pour autant la volonté de comprendre pourquoi, comment !
Antoine
"Youky" a écrit dans le message de news:
43c22a42$0$29210$Trés belle macro, superbe, et quand tout fonctionne la magie fait son
oeuvre.
Cela m'a fait plaisir d'avoir réussit ta demande.
Youky
A+
"Antoine76" a écrit dans le message de news:Rebonsoir Youki
En Auto_Open, j'ai une "mise à jour" de "l'état d'avancement de
dossier"
correspondant à chaque feuille (transfert du lien H pour un accès
rapide,et
recopie des cellules contenant différentes valeur caractéristiques de
l'évolution de chaque dossier) ; Pour plus d'Info , j'ai déposé les
lignesde code (réalisé pour une bonne part grace à MFPE) à la fin de ce
message.Sur ta proposition, j'ai transféré l'ensemble de ces lignes de
programme
sur
Workbook_Open, ce qui me donne exactement le même résultat (no comment
!).Ton idée était donc plus que recevable!
Quant à la macro que tu m'as écrite, elle fonctionne dans ce cas
IMPECCABLEMENT (no comment bis !).
A propos de ta macro, il est toujours très intéressant de voir comment
"d'autre(s)" font une macro que l'on ne sait pas soi-même appréhender ;
c'est peut-être là que l'on apprend le plus !...
Merci à toi
Antoine
' désactive le rafraîchissement de l'écran
Application.ScreenUpdating = False
' déclaration des variables du classement alphabétique
Dim a(256), j As Integer, k As Integer, n As Integer, temp
' comptage du nombre de feuilles
n = Sheets.Count
For j = 1 To n
a(j) = Sheets(j).Name
Next j
' tri des feuilles
For j = 1 To n
For k = j To n
If a(k) < a(j) Then
temp = a(k)
a(k) = a(j)
a(j) = temp
End If
Next k
Next j
' positionnement des feuilles selon la lettre
For j = 1 To n
Sheets(a(j)).Move before:=Sheets(j)
Next j
' déclaration des variables de la feuille sommaire
Dim wsh As Worksheet, i As Integer, H As Hyperlink, x As String,
RAs Range
' met la feuille Arrêt de travail type en Nième position des
feuilles
Sheets("Arrêt de travail type").Move After:=Sheets(Sheets.Count)
' met la feuille Sommaire en 1ère position des feuilles
Sheets("Sommaire").Move before:=Sheets(1)
' efface toutes les celules de la feuille Sommaire
Range("A:H").Select
Selection.ClearContents
' sélectionne la cellule B1 de la feuille "Sommaire"
Sheets("Sommaire").Select
' cycle de création des transfert de valeurs
Range("B1").Select
For Each wsh In ActiveWorkbook.Sheets
i = i + 1
' créé en colonne B un lien hypertexte pour toutes les feuilles du
classeur
ActiveSheet.Hyperlinks.Add Anchor:Îlls(i + 1, 1), Address:="",
_SubAddress:="'" & wsh.Name & "'" & "!A1",
TextToDisplay:=wsh.Name
' transfert de la date/début (B9 de chaque feuille) sur la feuille
"Sommaire"
Cells(i + 1, 2) = wsh.Range("B9")
' transfert l'état "En cours/Soldé" (D4 de chaque feuille) sur la
feuille "Sommaire"
Cells(i + 1, 3) = wsh.Range("D4")
' la remplace par la date de dernière I.J. de compagnie de chaque
feuille sur la feuille "Sommaire"
If Not LCase(Cells(i + 1, 3)) Like "en cours" Then Cells(i + 1,
3)_
Application.WorksheetFunction.Max(wsh.Range("J9:J200"))
' transfert l'état "Cadre/Non Cadre" (C3 de chaque feuille) sur la
feuille "Sommaire"
Cells(i + 1, 4) = wsh.Range("C3")
' transfert de la dernière I.J. Compagnie versée sur la feuille
"Sommaire"
Cells(i + 1, 5) = wsh.Range("N25")
' transfert du nombre de jours Compagnie (somme de P11 à P200) sur
la
feuille "Sommaire"
Cells(i + 1, 6) >> > Application.WorksheetFunction.Sum(wsh.Range("P11:P200"))
' transfert des I.J. totales versées /Compagnie (somme de K8 à
K200)
sur la feuille "Sommaire"
Cells(i + 1, 7) >> > Application.WorksheetFunction.Sum(wsh.Range("K9:K200"))
Next
' suprime le lien hyperT et les 3 cellules de droite de la 2ème
ligne
For Each H In Worksheets("Sommaire").Hyperlinks
If InStr(1, H.SubAddress, "Sommaire") Then
Set R = Range(H.Parent.Address)
R = "Salariés en arrêt"
Set R = R.Offset(0, 1)
R = "Début d' arrêt"
Set R = R.Offset(0, 1)
R = "Fin d' arrêt"
Set R = R.Offset(0, 1)
R = "Statut"
Set R = R.Offset(0, 1)
R = "I.J. Cie / jour"
Set R = R.Offset(0, 1)
R = "Nb. de jours"
Set R = R.Offset(0, 1)
R = "I.J. Cie cumulées"
H.Delete
End If
Next
' met en couleur les 7 cellules de titres
Range("A2:G2").Select
With Selection.Interior
.ColorIndex = 36
.Pattern = xlSolid
End With
With Selection.Font
.Name = "Arial"
.FontStyle = "Gras"
.Size = 12
.ColorIndex = 9
End With
' supprime les 6 cellules de droite du lien hyperT de Arrêt de
travail
type
For Each H In Worksheets("Sommaire").Hyperlinks
If InStr(1, H.SubAddress, "Arrêt de travail type") Then
Set R = Range(H.Parent.Address)
Set R = R.Offset(0, 1)
R = ""
Set R = R.Offset(0, 1)
R = ""
Set R = R.Offset(0, 1)
R = ""
Set R = R.Offset(0, 1)
R = ""
Set R = R.Offset(0, 1)
R = ""
Set R = R.Offset(0, 1)
R = ""
End If
Next
' applique à A2 le format de cellule de B2
Range("B2").Select
Selection.Copy
Range("A2").Select
Selection.PasteSpecial Paste:=xlFormats
Application.CutCopyMode = False
' réactive le rafraîchissement de l'écran
Application.ScreenUpdating = True
Range("A1").Select
End Sub
"Youky" a écrit dans le message de news:
43c15d47$0$6661$Salut Antoine,
Pour l'auto_Open je n'ai pas de solutions.
Je pense qu'il est plus facile de mettre la macro en :
Private Sub Workbook_Open()
plutôt qu'en Auto_Open
Ne sachant pas ce que fait cette macro dur dur.
Là je sèche, pose la question de nouveau au forumla manière d'utiliser Dim a(200, 20),
Cela crée un tableau à 2 dimensions
le 1er de 0 à 200 et le deuxieme 0 à 20
ce qui fait que je peux y loger 200 lignes sur 20 colonnes
ici 200 indique le nbre maxi de lignes pouvant être gardées en mémoire
bien sur que les "En cours" et pour 1 seule page
car au changement de fichier c'est réactualisé
si ligne=3 et colonne =1
a(ligne,colonne)="Antoine"
a(3,1) va renvoyer "Antoine"le rôle du $
pas sur de moi mais en principe cela fait que la variable est
considéréecomme du texte
c'est de moins en moins utilisé, peut être que ca marche sans le $, à
essayer
Youky
"Antoine76" a écrit dans le message de news:Bonsoir Youki,
Merci pour ta réponse. J'étais de sortie samedi soir, et je viens
seulement
de tester ton programme. Il fonctionne bien, à un petit détail près
:
je
ne
t'ai pas précisé que la 1ère page de tous les fichiers source
sollicités
est
déjà le fruit d'une réactualisation en Auto_Open (à partir de
l'ensemble
des
autres feuilles du classeur) ; c'est ce qui me fait apparaître le
message:
" Erreur d'exécution 1004...'Arrêt de travail Peugeot.xls' est
introuvable.
Vérifier l'orthographe du nom du classeur et la validité de
l'emplacement..."
J'ai essayé en supprimant la macro Auto_Open, cela fonctionne super.
J'ai essayé d'insérer "Application.DisplayAlerts = False" ou/et
" ActiveWorkbook.RunAutoMacros (xlAutoOpen)" ou
Workbooks(F).RunAutoMacros (xlAutoOpen), mais cela ne change rien!
Est-ce qu'il y a une solution pour le faire fonctionner en gardant
cette
Auto_Open (identique à tous les fichiers) ?
Petite question annexe, dans le code que tu as écris, je ne
comprends
pasplusieurs petites chose que tu as écrites et qui fonctionnent très
bien,
comme :
la manière d'utiliser Dim a(200, 20),
le rôle du $ dans Dir$(chem & "*.xls"),
et à quoi correspond la lettre "a" qui ne semble pas être une
variableetque je n'ai pas trouvé comme fonction ?
Dans tous les cas, Grand Merci pour ta contribution !
Antoine
"Youky" a écrit dans le message de news:
43c033a0$0$19695$Bonsoir,
le seul truc qui te reste à faire, dans un fichier vierge tu
inseres
un
module
et y mets cette macro et enregistre ton fichier dans le bon
répertoire(le mm que ceux à ouvrir)sous le nom de Youky(ou à modifier dans la
macro)
J'ai pas testé en entier mais je pense que c'est pas mal
Youky
Sub test()
Dim a(200, 20)
chem = ActiveWorkbook.Path
Dim F As String
F = Dir$(chem & "*.xls")
Do Until F = ""
If F = "Youky.xls" Then GoTo saute
Workbooks.Open F
Sheets(1).Select
n = 0
For k = 3 To [C65000].End(xlUp).Row
If Cells(k, 3) = "En cours" Then
n = n + 1
a(n, 1) = [c2]
For b = 2 To 10
a(n, b) = Cells(k, b)
Next b
End If
Next
Workbooks(ActiveWorkbook.Name).Close
For nl = 1 To n
lig = lig + 1
For k = 1 To 10
Cells(lig, k) = a(nl, k)
Next k
Next nl
saute:
F = Dir$
Loop
End Sub
"Antoine76" a écrit dans le message de news:Bonjour à tous,
Je voudrais créer une macro, dans un fichier Excel vierge, qui
ferait
un
récapitulatif "ciblé" de tous les fichiers contenus dans un
dossier"Clients".
Chaque fichier de ce dossier contient, toujours sur la première
page,
uneliste qui commence à partir de la ligne 3 jusqu'à n, comme
ci-après:
A B C D
EF G
1 ( ligne vide pour touche
d'activation
de
macros
...)
2 Noms Début Fin Statut
I.J.Cie
Jours Total
3 Bombard 13/02/04 30/09/04 NC 2,84
141477,72
4 Dupont 11/03/03 En cours C 11,56
815 8 279,42
...
L'objectif de la macro de ce nouveau fichier, serait de
transférer,pour
chaque fichier du dossier "Clients", toutes les lignes (à partir
dela3ème
ligne) de chaque 1ère page , mais dont la cellule de la colonne C
présentela mention "En cours", et, si possible, de faire précéder ce
transfertdela
ligne par le contenu de la cellule $K$2 (nom du client) de la
1ère
feuilledu fichier vers la colonne A
Je ne sais pas si j'ai pu énoncer assez clairement l'objectif de
lamacro,ainsi que la composition de chaque fichier. Si nécessaire, je
peux
joindrele fichier en cjoint...
Je ne sais pas comment faire pour créer une telle macro, et si il
est
possible de le faire sans ouvrir à chaque fois le fichier ?
Merci de vos conseils
Antoine