Ajout d'un index thématique dans Word en VBA

Jean-François Jousseaume (Sepia sur www.developpez.com)

Cet article a pour but de vous montrer comment créer un index thématique de Word en VBA, à l'aide d'un exemple d'un livre de cuisine, un autre de mes passetemps.
Attention, volontairement pour mettre en évidence des points précis ou des éléments de code, cette macro n'est pas forcément optimisée en temps de traitement.

- Titre : Ajout d'un index thématique dans Word en VBA

- Auteur : Jean-François Jousseaume (Sepia sur www.developpez.com)

- Parution : 12 décembre 2008

- Licence : Ce document est issu de http://www.developpez.com et reste la propriété exclusive de son auteur : Jean-François Jousseaume (Sepia sur www.developpez.com). La copie, modification et/ou distribution par quelque moyen que ce soit est soumise à l'obtention préalable de l'autorisation de l'auteur: Jean-François Jousseaume (Sepia sur www.developpez.com).

Sommaire

- 1. Introduction

- 2. La génération de l'index

- 2-A. Rappels

- 2-B. Principe

- 2-C. Explications

- 2-D. Code complet de la macro

- 2-E. Le fichier exemple

- 3. Remerciements

1 - Introduction

Ce tutoriel décrit comment créer ou mettre à jour un index thématique dans Word sur un exemple concret d'un document comportant quelques bonnes pratiques d'utilisation : titres, styles, champs de formulaires, tableaux corrects, table des matières, entête et pied de page, renvois, insertion d'images... autant d'éléments qui posent des problèmes récurrents aux DVPnautes.

- Ce tutoriel s'appuie sur le document Word "DVP_Livre_Cuisine_Sepia.doc".

- Le document est un extrait de 14 recettes de mon propre livre de cuisine qui contient une table des matières standard basé sur des titres (cf. le tutoriel de Heureux-Oli sur les tables des matières)

- Chaque recette est composée de la façon suivante :

- Une table d'index secondaire basée sur les catégories des recettes (apéros, entrées, plats, desserts...) est créée à partir d'une macro, dont je vais vous présenter le fonctionnement. Cet index est repérée par le signet "TitreTableDIndexParCategorie"

Exemple de page du livre de recettes

2 - La génération de l'index

2-A - Rappels

Pour les éléments de base utilisés, se référer aux différents tutoriels de Heureux-Oli sur DVP.com

- Numérotation des titres sous Word

- Table des matières sous Word

- Numérotation des pages sous Word

- Entêtes et pieds de page sous Word

2-B - Principe

La macro parcourt la table des matières entrée par entrée, chacune correspondant à une recette, puis récupère pour chaque recette sa catégorie.
La macro vérifie alors si cette catégorie est déjà présente, si c'est le cas la recette est ajoutée en fin de la liste des recettes de cette catégorie sinon on créé la catégorie.
Lorsque la table des matières est entièrement parcourue, on écrit alors la table d'index par catégorie.
Remarque : Dans la plupart des langages informatiques, l'agrandissement d'un tableau est complexe et ne peut s'effectuer une seule opération.
Il existe néanmoins des techniques qui permettent de le faire pour certains langages mais ces techniques dépendent du langage. Bien que cette technique existe en VBA (ReDim Preserve), elle est très couteuse en temps d'exécution.
Je vous présente aussi une technique basée sur la manipulation de chaines qui fonctionne avec tous les langages (mais attention cette technique n'est pas optimisée pour tous les langages).
On détermine d'abord un (ou plusieurs) marqueurs de séparation (qui ne sont pas utilisés dans le texte concerné) comme "$$$", "£££", "§§§"..., puis on utilise une variable de stockage temporaire de type chaine de caractères qui va contenir les textes concernés les uns après les autres séparés par le marqueur et on compte le nombre de textes. On finit alors par créer le tableau (avec la bonne taille qui maintenant est connue) puis on parcourt la chaine, séparateur après séparateur, pour placer les différents textes concernés dans le tableau, ce qui est très rapide.

2-C - Explications

- Nom de la macro

Sub DVP_InsererEtOuActualiserUnIndexThematique()

- Déclarations des tableaux qui contiennent les variables

Dim aLstRecettes() As String
Dim aLstTypes() As String
Dim aLstPrix() As String
Dim aLstDiff() As String

- Permet d'utiliser des tableaux réinitialisables
Remarque : les indices des tableaux commencent à 0

ReDim aLstRecettes(0 To 0) As String
ReDim aLstTypes(0 To 0) As String
ReDim aLstPrix(0 To 0) As String
ReDim aLstDiff(0 To 0) As String

- On récupère la table des matières (dans la variable aTdM)
Remarque 1 : on considère que

Remarque 2 : La mise à jour de la table des matières qu'avec le style "Titre 1" (pour ne pas avoir à gérer les variantes) ne fonctionne pas (ils restent toujours pris en compte) ==> traitement manuel

ActiveDocument.Range(Start:=ActiveDocument.TablesOfContents(1).Range.Start, _
End:=ActiveDocument.TablesOfContents(1).Range.End).Select
aTdM = ActiveDocument.TablesOfContents(1).Range.Text

- On parcourt la table des matières paragraphe par paragraphe
A chaque paragraphe, on incrément le nombre de recettes et on place le titre de la recette suivi du numéro de page dans une chaine de caractères en les séparant par les marqueurs "$" et "£"

aNbRecettes = 0
aTmpRecettes = ""
While InStr(aTdM, vbCr) &lt;&gt; 0
aNbRecettes = aNbRecettes + 1
aTmpRecettes = aTmpRecettes + Left(aTdM, InStr(aTdM, vbTab) - 1) + "$" + Left(Mid(aTdM, _
InStr(aTdM, vbTab) + 1), InStr(Mid(aTdM, InStr(aTdM, vbTab) + 1), vbCr) - 1) + "£"
aTdM = Mid(aTdM, InStr(aTdM, vbCr) + 1)
Wend

- On redimensionne le tableau des recettes (puisqu'on en connait maintenant le nombre)
On stocke la liste des recettes dans un tableau

ReDim aLstRecettes(0 To aNbRecettes)
For aI = 0 To aNbRecettes - 1
aLstRecettes(aI) = Left(aTmpRecettes, InStr(aTmpRecettes, "£") - 1)
aTmpRecettes = Mid(aTmpRecettes, Len(aLstRecettes(aI)) + 2)
Next

- On parcourt le tableau des titres de recettes pour les rechercher dans le contenu du document soit sur le style "Titre 1" ou soit sur une variante de la recette

Selection.find.ClearFormatting
Selection.find.Replacement.ClearFormatting
For aI = 0 To aNbRecettes - 1
Selection.HomeKey Unit:=wdStory
'// On regarde si la recette est une recette principale
Selection.find.Style = "Titre 1"
With Selection.find
.Text = Left(aLstRecettes(aI), InStr(aLstRecettes(aI), "$") - 1) + "^p"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.find.Execute
...
Next

- Lorsqu'on a retrouvé la recette, on sélectionne le tableau qui suit (pour une recette principale) ou le tableau qui précède (pour une variante)

If Selection.find.Found Then
Selection.Next(Unit:=wdTable, Count:=1).Select
Else
Selection.find.Style = "Titre 1 - Variante"
Selection.find.Execute
If Selection.find.Found Then
Selection.Previous(Unit:=wdTable, Count:=1).Select
End If
End If

- On vérifie que la sélection est bien dans un tableau
Cette vérification n'est pas indispensable (puisqu'on vient de sélectionner un tableau) mais elle permet de pointer du doigt que pour des langages interprétés
il faut vérifier les conditions supposées (ici le fait d'être dans un tableau)

If Selection.Information(wdWithInTable) Then
...
End If

- On récupère le contenu du champ de formulaire (type de plat : entrée, plat principal...) pour récupérer tous les types de plats pour créer des catégories
Remarque : on considère que le champ qui nous intéresse est le 1er
On vérifie si la catégorie trouvée existe, si elle existe, on ajoute la recette à la suite de celle de la même catégorie (ReDim Preserve), sinon on crée une nouvelle catégorie avec cette recette

aPasTrouve = True

aJ = LBound(aLstTypes)
While (aJ &lt; UBound(aLstTypes)) And (aPasTrouve)
If (Left(aLstTypes(aJ), InStr(aLstTypes(aJ), "$") - 1) = Selection.FormFields(1).result) Then
aPasTrouve = False
Else
aJ = aJ + 1
End If
Wend
If aPasTrouve Then
aLstTypes(aJ) = Selection.FormFields(1).result + "$"
ReDim Preserve aLstTypes(0 To (aJ + 1))
End If
aLstTypes(aJ) = aLstTypes(aJ) + aLstRecettes(aI) + "£"

- On supprime le contenu de la table précédente si elle existe
Pour cela, on se déplace au signet de repère de la table d'index (signet "TitreTableDIndexParCategorie") et on sélectionne jusqu'à la prochaine section

Selection.GoTo What:=wdGoToBookmark, Name:="TitreTableDIndexParCategorie"
Selection.Move Unit:=wdCharacter, Count:=2
Selection.MoveEnd Unit:=wdSection, Count:=1
Selection.MoveLeft Unit:=wdCharacter, Count:=3, Extend:=wdExtend

- Pour chaque catégorie, on écrit le contenu (donc la liste des recettes de cette catégorie) et on le passe en style "Catégorie de plats"

For aI = LBound(aLstTypes) To UBound(aLstTypes) - 1
With Selection
.TypeText Left(aLstTypes(aI), InStr(aLstTypes(aI), "$") - 1)
.TypeParagraph
.MoveUp Unit:=wdParagraph, Count:=1, Extend:=wdExtend
End With
Selection.Style = ActiveDocument.Styles("Catégorie de plats")
Selection.MoveRight Unit:=wdCharacter, Count:=1
...
Next

- On remplace les marqueurs de titres de recettes (ici "$") par des tabulations

With Selection
.TypeText Mid(aLstTypes(aI), InStr(aLstTypes(aI), "$") + 1)
.TypeParagraph
.MoveUp Unit:=wdParagraph, Count:=1, Extend:=wdExtend
End With
Selection.find.ClearFormatting
Selection.find.Replacement.ClearFormatting
With Selection.find
.Text = "$"
.Replacement.Text = "^t"
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.find.Execute Replace:=wdReplaceAll

- On remplace les marqueurs de pages de chaque recette (ici "£") par des sauts de paragraphe

With Selection.find
.Text = "£"
.Replacement.Text = "^p"
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.find.Execute Replace:=wdReplaceAll

- On remplace les marqueurs de pages de chaque recette (ici "£") par des sauts de paragraphe

With Selection.find
.Text = "£"
.Replacement.Text = "^p"
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.find.Execute Replace:=wdReplaceAll

- On positionne la tabulation à droite à 18 cm avec des points de suite (comme pour une table des matières)

Selection.ParagraphFormat.TabStops.Add Position:=CentimetersToPoints(18), _
Alignment:=wdAlignTabRight, Leader:=wdTabLeaderDots

- On déplace le point d'insertion pour ajouter la nouvelle catégorie après celle que l'on vient de traiter

Selection.MoveRight Unit:=wdCharacter, Count:=1

2-D - Code complet de la macro

Sub DVP_InsererEtOuActualiserUnIndexThematique()
Dim aLstRecettes() As String
Dim aLstTypes() As String
Dim aLstPrix() As String
Dim aLstDiff() As String

ReDim aLstRecettes(0 To 0) As String
ReDim aLstTypes(0 To 0) As String
ReDim aLstPrix(0 To 0) As String
ReDim aLstDiff(0 To 0) As String

'// On recupère la TdM
'// Attention, on considère que :
'//     1°) La TdM qui nous interresse est la 1ere
'//     2°) La TdM est à jour
'// La mise à jour de la table des matières qu'avec le style "Titre 1"
'//(pour ne pas avoir à gérer les variantes) ne fonctionne pas
'//     (ils restent toujours pris en compte) ==&gt; traitement manuel
ActiveDocument.Range(Start:=ActiveDocument.TablesOfContents(1).Range.Start, _
End:=ActiveDocument.TablesOfContents(1).Range.End).Select
aTdM = ActiveDocument.TablesOfContents(1).Range.Text

'// On stocke la TdM sous forme d'un tableau
aNbRecettes = 0
aTmpRecettes = ""
While InStr(aTdM, vbCr) &lt;&gt; 0
aNbRecettes = aNbRecettes + 1
aTmpRecettes = aTmpRecettes + Left(aTdM, InStr(aTdM, vbTab) - 1) + "$" + Left(Mid(aTdM, _
InStr(aTdM, vbTab) + 1), InStr(Mid(aTdM, InStr(aTdM, vbTab) + 1), vbCr) - 1) + "£"
aTdM = Mid(aTdM, InStr(aTdM, vbCr) + 1)
Wend
ReDim aLstRecettes(0 To aNbRecettes)
For aI = 0 To aNbRecettes - 1
aLstRecettes(aI) = Left(aTmpRecettes, InStr(aTmpRecettes, "£") - 1)
aTmpRecettes = Mid(aTmpRecettes, Len(aLstRecettes(aI)) + 2)
Next

'// On parcourt la liste des recettes pour retrouver les catégories
Selection.find.ClearFormatting
Selection.find.Replacement.ClearFormatting
For aI = 0 To aNbRecettes - 1
Selection.HomeKey Unit:=wdStory
'// On regarde si la recette est une recette principale
Selection.find.Style = "Titre 1"
With Selection.find
.Text = Left(aLstRecettes(aI), InStr(aLstRecettes(aI), "$") - 1) + "^p"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.find.Execute
If Selection.find.Found Then
Selection.Next(Unit:=wdTable, Count:=1).Select
Else '// On regarde si la recette est une variante
Selection.find.Style = "Titre 1 - Variante"
Selection.find.Execute
If Selection.find.Found Then
Selection.Previous(Unit:=wdTable, Count:=1).Select
End If
End If

If Selection.Information(wdWithInTable) Then
'// Attention, on considère que le champ de formulaire (type de plat : entrée, plat principal...)
'// qui nous interresse est le 1er
'// ==&gt; On va récupérer tous les types de plats pour créer des catégories
aPasTrouve = True

aJ = LBound(aLstTypes)
While (aJ &lt; UBound(aLstTypes)) And (aPasTrouve)
If (Left(aLstTypes(aJ), InStr(aLstTypes(aJ), "$") - 1) = Selection.FormFields(1).result) Then
aPasTrouve = False
Else
aJ = aJ + 1
End If
Wend
If aPasTrouve Then
aLstTypes(aJ) = Selection.FormFields(1).result + "$"
ReDim Preserve aLstTypes(0 To (aJ + 1))
End If
aLstTypes(aJ) = aLstTypes(aJ) + aLstRecettes(aI) + "£"
End If
Next

'// On supprime le contenu de la table précédente si elle existe
Selection.GoTo What:=wdGoToBookmark, Name:="TitreTableDIndexParCategorie"
Selection.Move Unit:=wdCharacter, Count:=2
Selection.MoveEnd Unit:=wdSection, Count:=1
Selection.MoveLeft Unit:=wdCharacter, Count:=3, Extend:=wdExtend

For aI = LBound(aLstTypes) To UBound(aLstTypes) - 1
With Selection
.TypeText Left(aLstTypes(aI), InStr(aLstTypes(aI), "$") - 1)
.TypeParagraph
.MoveUp Unit:=wdParagraph, Count:=1, Extend:=wdExtend
End With
Selection.Style = ActiveDocument.Styles("Catégorie de plats")
Selection.MoveRight Unit:=wdCharacter, Count:=1

With Selection
.TypeText Mid(aLstTypes(aI), InStr(aLstTypes(aI), "$") + 1)
.TypeParagraph
.MoveUp Unit:=wdParagraph, Count:=1, Extend:=wdExtend
End With
Selection.find.ClearFormatting
Selection.find.Replacement.ClearFormatting
With Selection.find
.Text = "$"
.Replacement.Text = "^t"
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.find.Execute Replace:=wdReplaceAll
With Selection.find
.Text = "£"
.Replacement.Text = "^p"
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.find.Execute Replace:=wdReplaceAll

Selection.ParagraphFormat.TabStops.Add Position:=CentimetersToPoints(18), _
Alignment:=wdAlignTabRight, Leader:=wdTabLeaderDots

Selection.MoveRight Unit:=wdCharacter, Count:=1
Next
End Sub

Pour les DVPnautes, il ne vous reste plus qu'à compléter ce livre avec vos propres recettes ou celles de vos amis et moi à vous souhaiter "Bon appétit".

2-E - Le fichier exemple

Vous pouvez télécharger le fichier exemple ici

3 - Remerciements

Je tiens à remercier toutes les personnes qui m'ont aidé et conseillé de près ou de loin à la rédaction de cet article, et plus particulièrement Olivier Lebeau (Heureux-oli sur DVP) et Lou Pitchoun pour leur aide sans cet article n'aurait jamais vu le jour.