VBA Importer texte Word dans Excel

Résolu
Zoul67 Messages postés 1959 Date d'inscription   Statut Membre Dernière intervention   -  
Zoul67 Messages postés 1959 Date d'inscription   Statut Membre Dernière intervention   -
Bonjour,

J'essaie désespérément d'importer un texte contenu dans un fichier Word vers Excel.
Pour l'instant mon code, c'est ceci : 
Sub import()
    file = ActiveWorkbook.Path & "\" & Range("A2").Value
    Dim AppWord As Word.Application
    Set AppWord = New Word.Application
    AppWord.ShowMe
    AppWord.Visible = True
    AppWord.DisplayAlerts = False
    'Ouvre le document Word

    Set DocWord = AppWord.Documents.Open(file)

    With AppWord
        .Selection.MoveDown Unit:=wdLine, Count:=1
        .Selection.MoveRight Unit:=wdCell
        .Selection.Copy
    End With

    DocWord.Close False
    AppWord.Quit
    Range("D2").Select
    Selection.Paste
End Sub


Cela marche à peu près, mais le texte copié contient des sauts de ligne (du coup dans Excel, j'ai du texte en D2, D3, etc.)
Y a-t-il moyen de mettre le texte copié dans une variable pour la replacer en cellule D2 ?
Au final, j'aurai une boucle important du texte de plusieurs centaines de fichiers Word... d'où le besoin de macro.

Merci d'avance.
A voir également:

1 réponse

Réponse 1 / 1
Zoul67 Messages postés 1959 Date d'inscription   Statut Membre Dernière intervention   149
 
Résolu.

Après les changements de cellule dans Excel, tous les sauts ont été supprimés, mais le code suivant me satisfait : 

Sub import()
    file = ActiveWorkbook.Path & "\" & Range("A2").Value
    Dim AppWord As Word.Application
    Set AppWord = New Word.Application
    AppWord.ShowMe
    AppWord.Visible = True
    AppWord.DisplayAlerts = False
    'Ouvre le document Word

    Set DocWord = AppWord.Documents.Open(file)

    With AppWord
        .Selection.MoveDown Unit:=wdLine, Count:=1
        .Selection.MoveRight Unit:=wdCell
        
    End With
    TEXTE = Replace(AppWord.Selection.Text, Chr(10), " --- ")
    TEXTE = Replace(TEXTE, Chr(13), " --- ")
    MsgBox TEXTE
    DocWord.Close False
    AppWord.Quit
    Range("D2").Select
    ActiveCell.FormulaR1C1 = TEXTE
End Sub

Bravo moi-même
1