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

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.

Article lu fois.

L'auteur

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

L'article

Publié le 12 décembre 2008

Version PDF Version hors-ligne

ePub, Azw et Mobi

Liens sociaux

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 : un titreun tableau décrivant la catégorie du plat (entrée chaude, plat, sauce...), l'estimation du coût (bon marché, modéré, assez cher), l'estimation de la réalisation (facile, moyen, difficile), le temps de préparation et de réalisation, les quantités (souvent je prend comme base 6 personnes) ainsi que d'autres informations comme les mots-clés (Halloween, Noël, Anniversaire...), la date de la création de la recette et son éventuelle référence si j'ai mis la recette sur un blog (souvent sur marmiton) ou la source si la recette provient de quelqu'un d'autre, les légumes d'accompagnement (pour les plats), le vin, les ustensiles, ces dernières rubriques étant assez rarement renseignées mais je prévois de le faire (un jour). La dernière ligne du tableau est une liste de commentaires pour recueillir les impressions et pour éviter de refaire plusieurs fois le même plat à mes convives ou pour noter un ingrédient qu'ils n'aiment pas.la liste des ingrédients (dans le style "Ingrédients" - noir et italique)la préparation (dans le style "Préparation" - en bleu)la réalisation (dans le style "Recette" - en noir)l'éventuelle finition (dans le style "Finition" - en orange)des éventuelles astuces (dans le style "Astuce" - en noir avec un retrait et précédé d'une puce fabriquée à partir d'une image GIF)La recette peut comporter une variante qui apparaît aussi dans la table des matières mais pas dans l'index (pour que l'exemple soit plus démonstratif)
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

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

Sélectionnez

Sub DVP_InsererEtOuActualiserUnIndexThematique()

Déclarations des tableaux qui contiennent les variables

Sélectionnez

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

Sélectionnez

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
La table des matières qui nous intéresse est la 1èreLa table des matières est à jour
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

Sélectionnez

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 "£"

Sélectionnez

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

Sélectionnez

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

Sélectionnez

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)

Sélectionnez

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)

Sélectionnez

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

Sélectionnez

	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

Sélectionnez

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"

Sélectionnez

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

Sélectionnez

	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

Sélectionnez

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

Sélectionnez

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)

Sélectionnez

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

Sélectionnez

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

2-D. Code complet de la macro▲

Sélectionnez

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.

Vous avez aimé ce tutoriel ? Alors partagez-le en cliquant sur les boutons suivants :