agregation dans répertoire

Créer une discussion
Répondre
  • Initiateur de la discussion Initiateur de la discussion C@thy
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
C@thy

C@thy

XLDnaute Barbatruc
Bonjour le forum,

je cherche une idée pour organiser mon travail.

Dans un répertoire xx j'ai 52 fichiers (ou 53 selon les années) nommée 1 à 52 (ou 53).
Dans chacun de ces 52 (ou 53) répertoires j'ai au maximun 5 sous-répertoires (pour les semaines sans jours fériés) nommés de lundi à vendredi.
Chaque sous-répertoire contient des news de l'AFP.
Chaque news est répertoriée selon un thème (Education, Social, Politique, Affaires étrangères, Immigration par ex.). Ce thème figure en titre de chaque news et en début du nom de fichier par exemple "SOCIAL Prime de noel pour les beneficiaires du RSA.doc"

chaque jour (et même plusieurs fois par jour) j'agrège tous les fichiers .doc du répertoire du jour en un seul doc de synthèse
je crée mon fichier de synthèse nommé prompteur-quotidien.doc dans chaque sous-rép (de lundi à vendredi)

mon souci est le suivant :
chaque semaine (le vendredi) je dois agréger tous les prompteur-quotidien.doc de chaque jour et mettre le fichier de synthèse prompteur-hebdo.doc dans le répertoire de la semaine (de 1 à 52 ou 53).

Je sélectionne le répertoire de travail au moyen d'un
Code: 
FileDialog(msoFileDialogFolderPicker)

donc, si le répertoire choisi est lundi à vendredi j'agrège la journée (mon code est déjà écrit,
c’est la façon de faire ce test qui m’embarrasse)
sinon j'agrège la semaine. (ça a l'air simple à dire, comme ça...)

Merci à vous😉 si vous avez une petite idée du moyen de faire ça😕

Le fait que ce soient des fichiers word n'a aucune importance dans l'histoire, la façon de procéder est îdentique s'il s'agit de classeurs excel.

Pour ne pas alourdir ce post et le rendre illisible, je vais mettre mon code en-dessous.

Edit : mais à mon avis ce code ne peut pas trop aider car ce que je veux faire ne s'y trouve pas, of course!

Bonne journée

C@thy
 
Dernière édition:
Trier par date Trier par votes
Re : agregation dans répertoire

Code: 
[COLOR=black][FONT=Verdana]Public sem As Variant, jsem$[/FONT][/COLOR]
[FONT=Verdana][COLOR=black]Public Chemin As String, Dossier As Object, Fichier As Object[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]Public ATraiter() As String, DateModif() As Date, I As Integer[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]Public semainedu As String[/COLOR][/FONT]
 
[COLOR=black][FONT=Verdana]Sub Main()[/FONT][/COLOR]
[FONT=Verdana][COLOR=black]AcquisitionDossier[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]Liste[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]Traitement 'constitution du document de synthèse[/COLOR][/FONT]
[COLOR=black][FONT=Verdana]TDM 'Table des matières[/FONT][/COLOR]
[FONT=Verdana][COLOR=black]semaine 'pour imprimer en tête du document semaine du au[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]End Sub[/COLOR][/FONT]
 
[COLOR=black][FONT=Verdana]Sub AcquisitionDossier()[/FONT][/COLOR]
[FONT=Verdana][COLOR=black]Dim fd As FileDialog, vrtSelectedItem As Variant[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]Set fd = Application.FileDialog(msoFileDialogFolderPicker) 'selection répertoire[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]With fd[/COLOR][/FONT]
[FONT=Verdana][COLOR=black] Chemin = ThisDocument.Path & "\"[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]End With[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]With fd[/COLOR][/FONT]
[FONT=Verdana][COLOR=black].InitialFileName = Chemin[/COLOR][/FONT]
[FONT=Verdana][COLOR=black] If .Show Then[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]     Chemin = .SelectedItems(1)[/COLOR][/FONT]
[FONT=Verdana][COLOR=black] End If[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]End With[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]Set fd = Nothing[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]End Sub[/COLOR][/FONT]
[COLOR=black][FONT=Verdana]Sub Liste()[/FONT][/COLOR]
[FONT=Verdana][COLOR=black]I = 0[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]Set Dossier = CreateObject("Scripting.FileSystemObject").GetFolder(Chemin)[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]For Each Fichier In Dossier.Files[/COLOR][/FONT]
[FONT=Verdana][COLOR=black] If Right(Fichier.Name, 4) = ".doc" Then ' liste les fichier DOC seulement[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]     ReDim Preserve ATraiter(I) ' pour les noms des fichiers valides[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]     ReDim Preserve DateModif(I) ' pour les dates[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]     ATraiter(I) = Fichier.Name[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]     DateModif(I) = Fichier.DateLastModified[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]     I = I + 1[/COLOR][/FONT]
[FONT=Verdana][COLOR=black] End If[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]Next[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]End Sub[/COLOR][/FONT]

puis mon traitement (qui n'est pas fini!)
Code: 
[COLOR=black][FONT=Verdana]Sub Traitement()[/FONT][/COLOR]
[FONT=Verdana][COLOR=black]Dim v[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]Selection.EndKey Unit:=wdStory[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]On Error GoTo Fin[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]For I = LBound(ATraiter) To UBound(ATraiter)[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]On Error GoTo 0[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]With Selection[/COLOR][/FONT]
[FONT=Verdana][COLOR=black] .InsertBreak Type:=wdPageBreak[/COLOR][/FONT]
[FONT=Verdana][COLOR=black] .TypeText Text:=ATraiter(I) & " : " & DateModif(I)[/COLOR][/FONT]
[FONT=Verdana][COLOR=black] .Style = ActiveDocument.Styles("Cathy")[/COLOR][/FONT]
[FONT=Verdana][COLOR=black] .TypeParagraph[/COLOR][/FONT]
[FONT=Verdana][COLOR=black] .Style = ActiveDocument.Styles("Normal")[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]ChangeFileOpenDirectory Chemin[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]Documents.Open filename:=ATraiter(I), _[/COLOR][/FONT]
[FONT=Verdana][COLOR=black] ConfirmConversions:=False, ReadOnly:=False, AddToRecentFiles:=False, _[/COLOR][/FONT]
[FONT=Verdana][COLOR=black] PasswordDocument:="", PasswordTemplate:="", Revert:=False, _[/COLOR][/FONT]
[FONT=Verdana][COLOR=black] WritePasswordDocument:="", WritePasswordTemplate:="", Format:= _[/COLOR][/FONT]
[FONT=Verdana][COLOR=black] wdOpenFormatAuto, XMLTransform:=""[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]v = Split(ActiveDocument.Path, "\")[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]sem = IIf(UBound(v) > 0, v(UBound(v) - 1), v(UBound(v)))[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]'MsgBox sem[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]Selection.WholeStory 'tout sélectionner[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]Selection.Copy[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]ActiveWindow.Close[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]Selection.EndKey Unit:=wdStory 'fin du doc[/COLOR][/FONT]
[FONT=Verdana][COLOR=black] .PasteAndFormat (wdPasteDefault)[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]End With[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]Next I[/COLOR][/FONT]
[COLOR=black][FONT=Verdana]'mise en forme****[/FONT][/COLOR]
[FONT=Verdana][COLOR=black]'polices[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]Selection.HomeKey Unit:=wdStory 'début du doc[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]With Selection[/COLOR][/FONT]
 
[FONT=Verdana][COLOR=black] .Style = ActiveDocument.Styles("Titre 1")[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]WordBasic.SelectSimilarFormatting[/COLOR][/FONT]
[FONT=Verdana][COLOR=black] .Style = ActiveDocument.Styles("Style")[/COLOR][/FONT]
[FONT=Verdana][COLOR=black] .WholeStory[/COLOR][/FONT]
[FONT=Verdana][COLOR=black] .MoveUp Unit:=wdLine, Count:=1[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]End With[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]With ActiveDocument[/COLOR][/FONT]
[FONT=Verdana][COLOR=black] On Error Resume Next[/COLOR][/FONT]
[FONT=Verdana][COLOR=black] .TablesOfContents(1).Delete[/COLOR][/FONT]
[FONT=Verdana][COLOR=black] On Error GoTo 0[/COLOR][/FONT]
[FONT=Verdana][COLOR=black] .TablesOfContents.Add Range:=Selection.Range, RightAlignPageNumbers:= _[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]     True, UseHeadingStyles:=False, LowerHeadingLevel:=1, _[/COLOR][/FONT]
[FONT=Verdana][COLOR=black] UpperHeadingLevel:=1, IncludePageNumbers:=True, AddedStyles _[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]     :="Cathy;1", UseHyperlinks:=True, HidePageNumbersInWeb:=True, _[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]     UseOutlineLevels:=True[/COLOR][/FONT]
[FONT=Verdana][COLOR=black] .TablesOfContents(1).TabLeader = wdTabLeaderDots[/COLOR][/FONT]
[FONT=Verdana][COLOR=black] .TablesOfContents.Format = wdIndexIndent[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]End With[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]Erase ATraiter[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]Erase DateModif[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]Exit Sub[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]Fin:[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]End Sub[/COLOR][/FONT]
 
[COLOR=black][FONT=Verdana]Sub TDM() 'Table des matières[/FONT][/COLOR]
[FONT=Verdana][COLOR=black]' ici transformation des styles en Titre1 et 2 pour créer le sommaire[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]For Each Paragraphe In ActiveDocument.Paragraphs[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]If Paragraphe.Style = "sous thème" Then Paragraphe.Style = "Titre1"[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]If Paragraphe.Style = "Thématique" Then Paragraphe.Style = "Titre2"[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]Selection.HomeKey Unit:=wdStory[/COLOR][/FONT]
[COLOR=black][FONT=Verdana]Selection.Collapse 'réduit la sélection au point d'insertion[/FONT][/COLOR]
[FONT=Verdana][COLOR=black]Selection.MoveRight Unit:=wdWord, Count:=1, Extend:=wdMove[/COLOR][/FONT]
[COLOR=black][FONT=Verdana] Selection.Find.ClearFormatting[/FONT][/COLOR]
[FONT=Verdana][COLOR=black] With Selection.Find[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]     .Text = "Prompteur N°483 – "[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]     .Replacement.Text = ""[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]     .Forward = True[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]     .Wrap = wdFindContinue[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]     .Format = False[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]     .MatchCase = False[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]     .MatchWholeWord = False[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]     .MatchWildcards = False[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]     .MatchSoundsLike = False[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]     .MatchAllWordForms = False[/COLOR][/FONT]
[FONT=Verdana][COLOR=black] End With[/COLOR][/FONT]
[FONT=Verdana][COLOR=black] Selection.Find.Execute[/COLOR][/FONT]
[FONT=Verdana][COLOR=black] With ActiveDocument[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]     .TablesOfContents(1).Delete[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]     .TablesOfContents.Add Range:=Selection.Range, RightAlignPageNumbers:= _[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]         True, UseHeadingStyles:=True, UpperHeadingLevel:=2, _[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]         LowerHeadingLevel:=2, IncludePageNumbers:=True, AddedStyles:= _[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]         "Titre 1;1;Thématique;2;sous thème;1;Titre;1", UseHyperlinks:=True, _[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]         HidePageNumbersInWeb:=True, UseOutlineLevels:=False[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]     .TablesOfContents(1).TabLeader = wdTabLeaderDots[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]     .TablesOfContents.Format = wdIndexIndent[/COLOR][/FONT]
[FONT=Verdana][COLOR=black] End With[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]End Sub[/COLOR][/FONT]

Code: 
[FONT=Verdana][COLOR=black][COLOR=black][FONT=Verdana]Application.Volatile[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]Sub semaine()[/FONT][/COLOR]
[FONT=Verdana][COLOR=black]Dim d2&, d3&, d4&[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]r = Date[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]r = CDate(r - 28)[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]d2 = r + 1 - Weekday(r, vbMonday)[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]d3 = DateSerial(Year(d2 + 3), 1, 1)[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]d4 = d3 + 1 - Weekday(d3, vbMonday) - (Weekday(d3, vbMonday) > 4) * 7[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]semaine = Format((d2 - d4) \ 7 + 1, "00")[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]End Sub[/COLOR][/FONT]
[/COLOR][/FONT]

Code: 
MsgBox "Nom du dossier parent : " & nFich(ThisDocument.Path)
Code: 
[FONT=Verdana][COLOR=black]Function nFich(tText As String)[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]If InStr(Right$(tText, Len(tText) - InStr(tText, "\")), "\") <> 0 Then[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]   tText = Right$(tText, Len(tText) - InStr(tText, "\"))[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]      a = nFich(tText)[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]   nFich = Left$(tText, InStr(tText, "\") - 1)[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]   Else[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]   nFich = "Le fichier " & tText & " est déjà à la racine !"[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]End If[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]End Function[/COLOR][/FONT]

Peut-être que je me complique la vie, et sûrement, même, que mon code n'est pas optimisé... 😱 du moins celui que j'ai écrit toute seule, mais au moins j'avance.
 
Dernière édition:
Vote positif 0 Vote négatif
Re : agregation dans répertoire

Arf! Je crois que j'ai mal posé ma question 😱

je cherche un truc du genre :

si le nom du répertoire que j'ai sélectionné est lundi ou mardi ou...vendredi (création d'une table avec 5 éléments?)
ou bien si le nom du répertoire est numérique je fais trait2 ?

Merci à vous si vous pouvez m'apporter une aide.

Biz

C@thy
 
Dernière édition:
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

P
  • Résolu(e)
Microsoft 365 Utiliser la même macro dans des feuilles différentes
2 3
Réponses
35
Affichages
786
cathodique
cathodique
S
  • Question Question
XL 2013 enregistrer une feuille excel converti en pdf dans un répertoire selon la valeur d'une cellule
Réponses
5
Affichages
315
Phil69970
Phil69970
M
  • Question Question
Microsoft 365 Aide à une formule sur un calendrier semainier
Réponses
4
Affichages
231
GALOUGALOU
GALOUGALOU
L
  • Question Question
XL 2021 Transformer des données verticales en horizontales et mettre à jour un graphique automatiquement
Réponses
11
Affichages
292
Leina
L
C
  • Question Question
XL pour MAC Répartir des personnes dans des équipes par roulement sur 5 jours
Réponses
6
Affichages
807
job75
job75
Calvus
  • Question Question
Microsoft 365 Recherche incomplète planning (problème de dates)
Réponses
13
Affichages
415
p56
p56
D
  • Question Question
XL 2021 création de planning perpétuel annualisé
Réponses
1
Affichages
534
vgendron
vgendron
Nico2978
  • Résolu(e)
XL 2019 Aide pour un module d'archivage de feuille en pdf dans répertoire
Réponses
5
Affichages
831
Nico2978
Nico2978
ArnaudSi
  • Question Question
XL pour MAC Besoin d'aide pour calculer automatiquement un jour de livraison dans Excel
Réponses
10
Affichages
1 K
ArnaudSi
ArnaudSi
chaelie2015
  • Résolu(e)
XL 2013 (RESOLU)Afficher les Jours de la Semaine en Infobulle
2
Réponses
20
Affichages
2 K
TooFatBoy
TooFatBoy
S
  • Résolu(e)
XL 2010 creation d'une InputBox pour creer plusieur tableau
2
Réponses
29
Affichages
2 K
Surfeur En Serie
S
Q
  • Question Question
XL 2019 Probleme liste déroulante via vba
Réponses
3
Affichages
659
Quicksland
Q
M
  • Question Question
XL pour MAC outil de gestion du temps de travail
Réponses
1
Affichages
983
gbinforme
G
S
  • Question Question
XL 2016 Bloquer la MaJ des formules de certains onglets
Réponses
2
Affichages
462
Hasco
Hasco
chinel
  • Résolu(e)
XL 2019 changer une valeur d'une cellule vis-à-vis d'une date
Réponses
9
Affichages
643
chinel
chinel
M
  • Résolu(e)
XL 2016 #REF ! et nom de cellule existant sur cellules nommées
2
Réponses
16
Affichages
1 K
Mak_tarmak
M
H
  • Question Question
XL 2021 [Résolu] Récupérer informations dans plusieurs classeurs et les centraliser dans un autre
2
Réponses
16
Affichages
1 K
Cousinhub
Cousinhub
B
  • Question Question
XL 2016 Formule avec plusieurs conditions pour planning heures annuelles
Réponses
5
Affichages
642
fanfan38
fanfan38
B
  • Résolu(e)
XL 2016 Récupérer des données si le nom d'un fichier est identique à un nom d'onglet
Réponses
4
Affichages
1 K
BBE
B
Usine à gaz
  • Résolu(e)
Microsoft 365 lister des fichiers
2
Réponses
19
Affichages
2 K
Usine à gaz
Usine à gaz
Retour