Dans un onglet Excel récupérer une table des matières d'un Word

Bonsoir,

A partir d'un onglet Excel, pouvoir récupérer la table des matières - que le titre - de plusieurs Word dont le chemin et le nom est contenu dans une plage de cellules de l'onglet. Le but : à partir d'une saisie d'un mot-clé dans une cellule, parcourir les titres collectés des tables de matières des Words pour indiquer quel document Word et son titre, sont concernés par le mot-clé. Ainsi, on peut en cliquer sur les titres concernés dans l'onglet Excel, ouvrir le document Word directement au paragraphe du titre trouvé dans la table des matières (j'aurai préféré directement positionné au paragraphe dans le Word). Cette solution est pour résoudre la question, quel document parle d'un mot-clé car la documentation est trop riche et non forcément événementiel. Supposons qu'une documentation décrit en plusieurs volumes, le fonctionnement d'une voiture. Je veux que les documents qui parlent des injecteurs et à quel endroit dans chaque document.

La solution est au point à une nuance près. Voici le code de la récupération de la table des matières d'un document :

*-----------------------------------------------------------------------------------------------------------

Sub TabMatWord()

Dim strFichier As String

Dim objWord As New Word.Application

Dim WordDoc As Word.Document

Dim TabMat, Champ

Dim I As Integer

strFichier = "C:\Users\TOTO\Documents\Volume01.docx"

' ouvrir un document Word

Set WordDoc = objWord.Documents.Open(strFichier, ReadOnly:=True)

' rendre Word visible

objWord.Visible = True

'----------

Set TabMat = WordDoc.TablesOfContents(1)

I = 0

For Each Champ In TabMat.Range.Fields

I = I + 1

Range("A" & I).Value = Champ.Result.Text '<=== !!!! le problème est là !!!!

Next

' fermer le document

objWord.Documents(1).Close

' quitter l'application Word

objWord.Quit

' libérer la mémoire

Set objWord = Nothing

MsgBox "FIN DE TRAITEMENT !!!"

End Sub

*----------------------------------------------------------------------------------------

"Champ.Result.Text" me donne Numéro de § + Le texte du titre + Numéro de page. Je ne veux que le texte du titre. Comment faire ?

Cordialement.

Bonjour,

voici un exemple :

Dim WordDoc As Object
Dim i As Integer, j As Integer
Dim Cible As Variant

    Set WordDoc = GetObject("C:\monFichier.doc")

    For i = 1 To WordDoc.Tables(1).Rows.Count
        For j = 1 To WordDoc.Tables(1).Columns.Count
            Cible = WordDoc.Tables(1).Columns(j).Cells(i)

            Sheets(1).Cells(i, j) = _
            Application.WorksheetFunction.Substitute(Cible, vbCr, vbLf)
            Sheets(1).Cells(i, j) = _
            Left(Sheets(1).Cells(i, j), Len(Sheets(1).Cells(i, j)) - 1)
        Next j
    Next i

slt,

à tester!

Sub TabMatWord()
Dim strFichier As String
Dim objWord As New Word.Application
Dim WordDoc As Word.Document

Dim TabMat, Champ
Dim I As Integer

strFichier = "C:\Users\TOTO\Documents\Volume01.docx"

' ouvrir un document Word
Set WordDoc = objWord.Documents.Open(strFichier, ReadOnly:=True)
' rendre Word visible
objWord.Visible = True

'----------
Set TabMat = WordDoc.TablesOfContents(1)
I = 0
For Each Champ In TabMat.Range.Fields
tString = Champ.Result.Text
I = I + 1
Range("A" & I).Value = Left(tString, Len(tString) - 1) '<=== !!!! le problème est là !!!!
Next

' fermer le document
objWord.Documents(1).Close
' quitter l'application Word
objWord.Quit

' libérer la mémoire
Set objWord = Nothing

MsgBox "FIN DE TRAITEMENT !!!"

End Sub

sinon il faut passer par le biais de Headings je pense

Bonne journée

Bonsoir,

Tout d'abord, mes remerciements pour vos réponses.

A => i20100

Je bloque sur la ligne "For i = 1 To WordDoc.Tables(1).Rows.Count."

Merci pour cette proposition de solution.

A => m3ellem1

Cette solution supprime que le dernier caractère situé à droite.

Ex 01 : « 5.2. Texte Titre2 » => 5.2. est la référence du §. On trouve ensuite le texte du titre puis le Numéro de page – ici 2. La solution donne : « 5.2. Texte Titre » (le 2 a disparu).

Ex 02 : « 5.2. Texte Titre32 » => 5.2. est la référence du §. On trouve ensuite le texte du titre puis le Numéro de page – ici 32. La solution donne : « 5.2. Texte Titre3 » (le 2 a disparu pas le 3).

J’ai fini par trouver la solution :

Sub boucleParagraphesWord()
'necesite d'activer la reference Microsoft Word xx.x Object Library
Dim appWrd As Word.Application
Dim docWord As Word.Document
Dim Paragraphe As Paragraph
Dim i As Integer

Set appWrd = CreateObject("Word.Application")
appWrd.Visible = True
Set docWord = appWrd.Documents.Open("C:\monDocument.doc")

For Each Paragraphe In docWord.Paragraphs
If Paragraphe.Range.ListFormat.ListValue <> 0 Then
i = i + 1
Cells(i, Paragraphe.Range.ListFormat.ListLevelNumber) = _
Paragraphe.Range.ListFormat.ListString
Cells(i, Paragraphe.Range.ListFormat.ListLevelNumber + 1) = _
Paragraphe.Range.Sentences(1).Text
End If
Next

End Sub

Cela sépare bien la référence § du texte du Titre. Considérons que c’est résolu.

Il me reste un petit problème. Dans l’onglet Excel, pour accéder au Word, je passe par la fonction LIEN_HYPERTEXTE([document Word]Titre sur le lequel pointer ; « Lien »). Cela fonctionne mais cela pointe dans le titre contenu dans la Tableau des matières et non au niveau du Titre dans le Word. Solution ?

Cordialement.

re,

essai comme ça,

Dim WordDoc As Object
Dim i As Integer, j As Integer
Dim Cible As Variant

    Set WordDoc = GetObject("C:\Users\TOTO\Documents\Volume01.docx")

    For i = 1 To  WordDoc.TablesOfContents(1).Rows.Count
        For j = 1 To WordDoc.TablesOfContents(1).Columns.Count
            Cible = WordDoc.TablesOfContents(1).Columns(j).Cells(i)

            Sheets(1).Cells(i, j) = _
            Application.WorksheetFunction.Substitute(Cible, vbCr, vbLf)
            Sheets(1).Cells(i, j) = _
            Left(Sheets(1).Cells(i, j), Len(Sheets(1).Cells(i, j)) - 1)
        Next j
    Next i

Bonjour i20100,

J'ai essayé mais j'ai une erreur d'exécution "438" : Propiété ou méthode non gérée par cet objet, sur la ligne [b]For i = 1 To WordDoc.TablesOfContents(1).Rows.Count

[/b]

Cordialement.