XL 2019 VBA Import d'un tableau Word sur Excel

J

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.
 
Trier par date Trier par votes
p56

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
 
Vote positif 1 Vote négatif
J

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.
 
Vote positif 0 Vote négatif
job75

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
Vote positif 0 Vote négatif
J

Jérémy26

XLDnaute Nouveau
job75 à dit:
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+
Cliquez pour agrandir...
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
Vote positif 0 Vote négatif
J

Jérémy26

XLDnaute Nouveau
p56 à dit:
Jérémy, avez-vous vu ma réponse-démo juste avant votre dernier message?
Cliquez pour agrandir...
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: 33
  • Nouveau Document Microsoft Word.docx
    15.2 KB · Affichages: 3
Dernière édition:
Vote positif 0 Vote négatif
p56

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: 13
Dernière édition:
Vote positif 1 Vote négatif
J

Jérémy26

XLDnaute Nouveau
p56 à dit:
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
Cliquez pour agrandir...
Merci beaucoup pour ton aide
 
Vote positif 0 Vote négatif
J

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
 
Vote positif 0 Vote négatif
J

Jérémy26

XLDnaute Nouveau
p56 à dit:
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
Cliquez pour agrandir...
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
 
Vote positif 0 Vote négatif
job75

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
Vote positif 0 Vote négatif

Discussions similaires

Mathos
  • Résolu(e)
XL 2021 Copie de certaines données Excel sur Word
2
Réponses
28
Affichages
802
Mathos
Mathos
A
  • Question
XL 2019 copier un tableau Excel dans un document word
Réponses
2
Affichages
316
chris
chris
B
  • Question
XL 2021 Transfert tableau structuré EXCEL à un endroit précis de WORD
Réponses
8
Affichages
820
job75
job75
T
  • Question
XL 2016 Preparer mon publipostage avant export
Réponses
0
Affichages
81
tuti
T
M
  • Question
XL 2010 Impossible d'exécuter la macro. Importe Excel vers Word.
Réponses
6
Affichages
371
wDog66
wDog66
D
  • Question
Microsoft 365 Rapprochement utilisateur type
Réponses
11
Affichages
364
mapomme
mapomme
C
  • Question
XL 2021 Passage de Word à Excel
2
Réponses
25
Affichages
1 K
Nain porte quoi
N
C
  • Question
XL 2019 vba excel : masquer un tableau word
Réponses
9
Affichages
665
CBX
C
alexandre33260
  • Résolu(e)
XL 2021 Copie cellules Excel vers Word avec mise à jour automatique
2
Réponses
29
Affichages
1 K
alexandre33260
alexandre33260
J
  • Résolu(e)
XL 2019 Important : Nommer fichier grâce aux éléments de publipostage
Réponses
6
Affichages
583
JacquesO
J

Membres actuellement en ligne

16 membres et 75 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
315 096
Messages
2 116 175
Membres
112 677
dernier inscrit
Justine11