C@thy
XLDnaute Barbatruc
Bonjour le forum,
Dans un document j'ai un style Cathy avec le nom du fichier .doc qui a été copié dans le document et la date de dernière modif de ce fichier, ensuite dans un style sous thème j'ai le thème et ensuite le texte qui va avec.
je souhaiterais trier ce document par thème et à l'intérieur par date de dernière modif.
(ensuite je crée mon sommaire trié de cette façon, c'est le but de la manip).
là, en fait, je trie par nom du fichier.
Comme le thème figure en 1er dans mon nom de fichier, c'est donc trié par thème
je vais ouvrir un par un les fichiers selon cet ordre et je les copie dans mon doc. de synthèse (fichier joint)
Comment est-il possible de trier, à l'intérieur d'un même thème, par date et heure de dernière mise à jour?
Ensuite j'ai une routine qui élimine les titres identiques pour créer mon sommaire
Si vous avez des idées, merci de m'en faire part.
Je peux changer l'ordre de mes titres si c'est plus facile, par exemple mettre le nom du fichier avec la date et heure de dernière modif sous le titre de style sous thème
je recherche tous les styles sous thème pour un même libellé de thème (ex. AFFAIRES ETRANGERES) je compare les dates, je mets la date la plus récente en 1er etc...
Merci à vous, toutes les idées sont les bienvenues.
Bises et bonne journée
C@thy
Dans un document j'ai un style Cathy avec le nom du fichier .doc qui a été copié dans le document et la date de dernière modif de ce fichier, ensuite dans un style sous thème j'ai le thème et ensuite le texte qui va avec.
je souhaiterais trier ce document par thème et à l'intérieur par date de dernière modif.
(ensuite je crée mon sommaire trié de cette façon, c'est le but de la manip).
Code:
Sub ListeWeek()
ChangeFileOpenDirectory chemin
Set Dossier = CreateObject("Scripting.FileSystemObject").getfolder(chemin)
i = 0
For Each SousDossier In Dossier.SubFolders
chemin = SousDossier
For Each Fichier In SousDossier.Files
If Right(Fichier.Name, 4) = ".doc" And LCase(Left(Fichier.Name, 9)) <> "prompteur" Then ' liste les fichier DOC seulement
ReDim Preserve ATraiter(i) ' pour les noms des fichiers valides
ReDim Preserve DateModif(i) ' pour les dates
ReDim Preserve ATraiterchem(i)
ATraiter(i) = Fichier.Name
DateModif(i) = Fichier.DateLastModified
ATraiterchem(i) = chemin & "\" & Fichier.Name
i = i + 1
End If
Next
Next
Call tri(ATraiter, 0, UBound(ATraiter, 1))
End Sub
Code:
Sub tri(a, gauc, droi)
ref = a((gauc + droi) \ 2)
g = gauc: d = droi
Do
Do While a(g) < ref: g = g + 1: Loop
Do While ref < a(d): d = d - 1: Loop
If g <= d Then
Temp = a(g): a(g) = a(d): a(d) = Temp
g = g + 1: d = d - 1
End If
Loop While g <= d
If g < droi Then Call tri(a, g, droi)
If gauc < d Then Call tri(a, gauc, d)
MsgBox Join(ATraiter, vbLf) 'vérif
End Sublà, en fait, je trie par nom du fichier.
Comme le thème figure en 1er dans mon nom de fichier, c'est donc trié par thème
je vais ouvrir un par un les fichiers selon cet ordre et je les copie dans mon doc. de synthèse (fichier joint)
Comment est-il possible de trier, à l'intérieur d'un même thème, par date et heure de dernière mise à jour?
Ensuite j'ai une routine qui élimine les titres identiques pour créer mon sommaire
Code:
Sub RechercherStyle()
Dim them As String
Selection.HomeKey unit:=wdStory
Selection.Find.ClearFormatting
Selection.Find.Style = ActiveDocument.Styles("sous thème")
Selection.Find.Text = ""
Selection.Find.Execute 'on cherche le 1 er item
them = Selection.Text
Selection.MoveRight unit:=wdWord, Count:=1, Extend:=wdMove
Selection.Collapse
Selection.Find.Execute 'On est au 2eme
Do
If Selection.Text = them Then
Selection.Delete
Else
them = Selection.Text
End If
Loop While Selection.Find.Execute 'on recherche le style suivant
End Sub
Code:
Sub TDM() 'Table des matières
Selection.HomeKey unit:=wdStory
On Error Resume Next
ActiveDocument.TablesOfContents(1).Delete
Selection.Find.ClearFormatting
With Selection.Find
.Text = "SOMMAIRE"
.Replacement.Text = ""
End With
Selection.Find.Execute
Selection.Collapse 'réduit la sélection au point d'insertion
Selection.MoveRight unit:=wdWord, Count:=3, Extend:=wdMove
With ActiveDocument
.TablesOfContents.Add Range:=Selection.Range, RightAlignPageNumbers:= _
True, UseHeadingStyles:=True, UpperHeadingLevel:=2, _
LowerHeadingLevel:=2, IncludePageNumbers:=True, AddedStyles:= _
"Titre 1;1;Thématique;2;sous thème;1;Titre;1", UseHyperlinks:=True, _
HidePageNumbersInWeb:=True, UseOutlineLevels:=False
.TablesOfContents(1).TabLeader = wdTabLeaderDots
.TablesOfContents.Format = wdIndexIndent
End With
Selection.InsertBreak Type:=wdPageBreak
End SubJe peux changer l'ordre de mes titres si c'est plus facile, par exemple mettre le nom du fichier avec la date et heure de dernière modif sous le titre de style sous thème
je recherche tous les styles sous thème pour un même libellé de thème (ex. AFFAIRES ETRANGERES) je compare les dates, je mets la date la plus récente en 1er etc...
Merci à vous, toutes les idées sont les bienvenues.
Bises et bonne journée
C@thy
