Importation de données word vers excel

[QuatarII]

Bonjour,

Je me permet de me tourner vers la communauté Excel Downloads pour une question dont je n'arrive pas à trouver la réponse.

J'aimerais importer dans un fichier Excel à l'aide d'une macro uniquement le premier de mes fichiers Word.

J'ai réussi pour mes autre données de mes fichiers words grâce à la macro du Grand Chaman Excel (http://www.gcexcel.com/vba-importer-des-donnees-de-word-vers-excel/) Mais mes fichiers Word sont construis de telle sorte à ce que j'ai besoin d'extraire le première paragraphe mais ce première paragraphe ne suis aucun motif.

Si vous pouvez me proposer une solution ou bien une modification de la macro du Grand Chaman Excel je vous en serais extrêmement reconnaissant.

Merci bien.

 

[Lone-wolf]

Bonjour QuatarII et bienvenue sur XLD . Bonjour le Forum

Si c'est juste un document...

Option Explicit

Sub test()
Dim WordDoc As Word.Document
Dim WordApp As Word.Application

                     'Chemin et nom du document à modifier
    fichier = ThisWorkbook.Path & "\Lettre.doc"

    Set WordApp = New Word.Application
    WordApp.Visible = False
    Set WordDoc = WordApp.Documents.Open(fichier, ReadOnly:=True)

    With WordApp
             .Selection.WholeStory
             .Selection.Copy
    End With

    [A2].PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
    WordApp.Application.Quit

   Set WordApp = Nothing
   Set WordDoc = Nothing

End Sub

Oubien comme ceci. Mais il faut compter tous les paragraphes avant.
Par1 = xxxxxxxxxxxxx
Par2 =""
Par3 = xxxxxxxxxxxxx etc.

Option Explicit

Sub Copier_ParagWord()
Dim WordApp As Word.Application
Dim WordDoc As Word.Document
Dim fichier As String
Dim  i As Long, x As Long

    fichier = ThisWorkbook.Path & "\Lettre.doc"

    Set WordApp = New Word.Application
    WordApp.Visible = False
    Set WordDoc = WordApp.Documents.Open(fichier, ReadOnly:=True)

    For i = 1 To 9
        x = x + 1
        Cells(x + 1, 1) = WordDoc.Paragraphs.Item(x).Range.Text
    Next
    WordDoc.Close False
    WordApp.Quit
    Set WordApp = Nothing
    Set WordDoc = Nothing

End Sub