XL 2019 VBA Import d'un tableau Word sur Excel

Jérémy26

XLDnaute Nouveau
Bonjour, j'ai fais un programme VBA sur Excel qui ouvre un document Word copie un tableau et le colle sur un feuille de mon Excel.
Le problème c'est que lorsque j'ai des retour à la ligne dans une case du tableau, Excel me crée une autre cellule. Donc par exemple : Si dans un case (cellule) de mon tableau Word j'ai du texte avec 2 retour à la ligne dans mon texte, une fois importé mon tableau dans Excel on a 3 cellules avec le texte séparé en trois du coup, au lieu d'une cellule sur Word.
Merci de bien vouloir m'aider.
 

p56

XLDnaute Occasionnel
Bonjour,
Il suffit de remplacer à la volée le retour chariot par un Chr(10) par exemple du genre :
VB:
Dim S As String

    S = WordDoc.Tables(1).Cell(1, 1).Range.Text
    S = Replace(S, vbCrLf, Chr(10))
    ThisWorkbook.Sheets("Feuil1").Range("A1").Value = S
 

Jérémy26

XLDnaute Nouveau
Avec cette solution je ne pouvais plus faire directement un copier d'un tableau Word puis coller sur Excel en macro. J'ai utilisé cette solution pour récupérer les données de mon tableau case par case. Cependant lorsque j'ai des case fusionnées sur mon tableau Word, je récupère bien la donné de la case la plus à gauche mais je traite aussi les autre ce qui mets en erreur ma macro. J'aimerai savoir comment je peux faire pour déterminer si mes case son fusionné ou pas sur le document Word pour adapter mon programme et récupérer juste la case de gauche, merci de m'apporter une solution à ce nouveau problème.
 

job75

XLDnaute Barbatruc
Bonjour Jérémy26, p56,

En général copier Word vers Excel ne pose pas de problème :
VB:
Sub CopierWord()
'le document Word doit être ouvert
Application.ScreenUpdating = False
With Feuil1 'CodeName à adapter
    .Cells.Delete 'RAZ
    GetObject(, "Word.Application").ActiveDocument.Tables(1).Range.Copy 'copie Word
    .[A1].Select
    .Paste 'colle sur Excel
    .[A1].Select
End With
End Sub
Ouvrez le document Word et cliquez sur le bouton du fichier Excel.

A+
 

Pièces jointes

  • Copier Word(1).xlsm
    17.4 KB · Affichages: 16
  • Doc Word.docx
    12.3 KB · Affichages: 9

Jérémy26

XLDnaute Nouveau
Bonjour Jérémy26, p56,

En général copier Word vers Excel ne pose pas de problème :
VB:
Sub CopierWord()
'le document Word doit être ouvert
Application.ScreenUpdating = False
With Feuil1 'CodeName à adapter
    .Cells.Delete 'RAZ
    GetObject(, "Word.Application").ActiveDocument.Tables(1).Range.Copy 'copie Word
    .[A1].Select
    .Paste 'colle sur Excel
    .[A1].Select
End With
End Sub
Ouvrez le document Word et cliquez sur le bouton du fichier Excel.

A+
Mon problème c'est les retour à la ligne qui crée de nouvelles cellules lors que j'utilise cette solution.
J'ai modifier le document word avec tableau type pour que vous puissiez visualiser mon problème concrètement. Cordialement
 

Pièces jointes

  • Copier Word(1).xlsm
    17.4 KB · Affichages: 1
  • Nouveau Document Microsoft Word.docx
    15.2 KB · Affichages: 6

Jérémy26

XLDnaute Nouveau
Jérémy, avez-vous vu ma réponse-démo juste avant votre dernier message?
Oui j'ai vu votre démo, je suis débutant en VBA, j'essai de comprendre comment ça fonction pour pouvoir l'appliquer sur un tableau type comme celui-ci.
Pour e moment j'obtiens ce résultat :
Merci pour ta démo. :)
 

Pièces jointes

  • Sans titre.png
    Sans titre.png
    109.7 KB · Affichages: 29
  • Nouveau Document Microsoft Word.docx
    15.2 KB · Affichages: 3
Dernière édition:

p56

XLDnaute Occasionnel
Oui c'est curieux?! je constate le même effet ... mais je vais continuer à chercher ce qui coince pour ce doc ...
Edit : je suis un idiot, j'ai interverti les lignes et les colonnes!
Voici ici un code bien plus propre :

Code:
Sub Demo_Recup_Tableaux()
Dim lg As Integer, cl As Integer, i As Integer, j As Integer, k As Integer
Dim S As String, T As Variant

    Open_Word Word_A_Lire
    With WordDoc
        For i = 1 To .Tables.Count
            lg = .Tables(i).Rows.Count
            cl = .Tables(i).Columns.Count
            ReDim T(1 To lg, 1 To cl)
            For j = 1 To lg
                For k = 1 To cl
                    S = ""
                    If Exist_cell(i, j, k) Then
                        S = .Tables(i).Cell(j, k).Range.Text
                        S = Replace(Replace(S, Chr(7), ""), Chr(13), Chr(10))
                        T(j, k) = S
                    End If
                Next k
            Next j
            With ThisWorkbook.Sheets("Feuil1")
                .Cells(2 + ((i - 1) * 15), 1).Resize(UBound(T, 1), UBound(T, 2)) = T
            End With
        Next i
    End With
    Close_Word True
End Sub
 

Pièces jointes

  • Récup tableaux Word.xlsm
    26.9 KB · Affichages: 9
Dernière édition:

Jérémy26

XLDnaute Nouveau
Oui c'est curieux?! je constate le même effet ... mais je vais continuer à chercher ce qui coince pour ce doc ...
Edit : je suis un idiot, j'ai interverti les lignes et les colonnes!
Voici ici un code bien plus propre :

Code:
Sub Demo_Recup_Tableaux()
Dim i As Integer, j As Integer, k As Integer, lg As Integer, cl As Integer
Dim S As String, T As Variant, ce As Object

    Open_Word Word_A_Lire
    With WordDoc
        For i = 1 To .Tables.Count
            lg = .Tables(i).Rows.Count
            cl = .Tables(i).Columns.Count
            ReDim T(1 To lg, 1 To cl)
            For j = 1 To lg
                For k = 1 To cl
                    S = ""
                    If Not Exist_cell(i, j, k) Then
                        S = WordDoc.Tables(i).Cell(j, k).Range.Text
                        S = Replace(Replace(S, Chr(7), ""), Chr(13), Chr(10))
                        T(j, k) = S
                    End If
                Next k
            Next j
            ThisWorkbook.Sheets("Feuil1").Cells(2, i * 10).Resize(UBound(T, 1), UBound(T, 2)) = T
        Next i
    End With
    Close_Word
End Sub
Merci beaucoup pour ton aide
 

Jérémy26

XLDnaute Nouveau
Bonjour je viens de remarquer que j'ai des données avec des retours à la ligne avec de puce "•" est possible de garde les puces ? c'est surement ce bout de programme qui me les enlèves.
VB:
S = .Tables(i).Cell(j, k).Range.Text
S = Replace(Replace(S, Chr(7), ""), Chr(13), Chr(10))
T(j, k) = S
 

Jérémy26

XLDnaute Nouveau
Oui c'est curieux?! je constate le même effet ... mais je vais continuer à chercher ce qui coince pour ce doc ...
Edit : je suis un idiot, j'ai interverti les lignes et les colonnes!
Voici ici un code bien plus propre :

Code:
Sub Demo_Recup_Tableaux()
Dim lg As Integer, cl As Integer, i As Integer, j As Integer, k As Integer
Dim S As String, T As Variant

    Open_Word Word_A_Lire
    With WordDoc
        For i = 1 To .Tables.Count
            lg = .Tables(i).Rows.Count
            cl = .Tables(i).Columns.Count
            ReDim T(1 To lg, 1 To cl)
            For j = 1 To lg
                For k = 1 To cl
                    S = ""
                    If Exist_cell(i, j, k) Then
                        S = .Tables(i).Cell(j, k).Range.Text
                        S = Replace(Replace(S, Chr(7), ""), Chr(13), Chr(10))
                        T(j, k) = S
                    End If
                Next k
            Next j
            With ThisWorkbook.Sheets("Feuil1")
                .Cells(2 + ((i - 1) * 15), 1).Resize(UBound(T, 1), UBound(T, 2)) = T
            End With
        Next i
    End With
    Close_Word True
End Sub
Bonjour, j'ai un soucis par rapport à ce programme.
Je récupère bien le texte d'une case dans la tableau word depuis l'excel mais si mon texte avait une tabulation avec puce, je la perd. Pouvez-vous m'aider ?
@p56
 

job75

XLDnaute Barbatruc
Bonjour Jérémy26,

Copy-Paste traite correctement les puces Word il me semble, bien sûr avec renvois à la ligne.

A+
 

Pièces jointes

  • Copier Word(2).xlsm
    17 KB · Affichages: 7
  • Nouveau Document Microsoft Word.docx
    15.2 KB · Affichages: 5

Discussions similaires

Statistiques des forums

Discussions
311 725
Messages
2 081 945
Membres
101 849
dernier inscrit
florentMIG