Import arborescence de word vers excel

acognard

XLDnaute Nouveau
Bonjour,
je suis en possession d'1 doc word (97) et je veux transférer son contenu dans 1 doc excel (97 SR2).
Chaque chapitre deviendrait 1 onglet et chaque point suivant (sur 3 niveau) serait injecté dans 1 colonne.
Par ex pour 1 CHAP,
1.1 sous-chap 1
1.1.1 sous-sous-chap1.1
1.1.2 sous-sous-chap1.2
1.2 sous-chap 2
1.2.1 sous-sous-chap2.1
1.2.2 sous-sous-chap2.2

Donnerait ceci enligne colonne

1.1 | 1.1.1 | 1.1.2
1.2 | 1.2.1 | 1.2.2

J'ai essayé 1 macro trouvée ici , mais ca plante à la 2ieme ligne :
Dim wordApp As Word.Application
Dim wordDoc As Word.Document

Erreur de compil, biblio ou projet introuvable

Merci d'avance.
 

MichelXld

XLDnaute Barbatruc
bonjour

cet exemple permet de recuperer l'arborescence des paragraphes d'un document Word
Chaque paragraphe est supposé débuter par une numérotation


tu dois prealablement activer la reference 'Microsoft Word xx.x Object Library'
dans l'editeur de macros
Menu Outils
References
coches la ligne 'Microsoft Word xx.x Object Library'
cliques sur OK


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



il te restera à adapter la mise en forme pour ton projet


bonne journée
MichelXld
 

MichelXld

XLDnaute Barbatruc
bonjour

j'espere que cette adaptation pourra t'aider

Sub boucleParagraphesWord_V02()
'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 Pr As String
Dim i As Integer
Dim Tableau(2) 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

If Pr <> '' Then Cells(Tableau(0), Tableau(1)) = Pr
Pr = ''
Tableau(0) = i
Tableau(1) = Paragraphe.Range.ListFormat.ListLevelNumber + 2
Else

Pr = Pr & vbLf & Paragraphe.Range.Text
End If
Next Paragraphe
End Sub




bonne journée
MichelXld
 

Discussions similaires