从 Word (.docx) 中提取表格到 Excel

问题描述

我正在尝试提取 Word 文件中存在的表格,并将它们复制/粘贴到 Excel 文件中。我尝试使用“while...Wend”编写 VBA 宏来执行此操作,但程序在 While WordDoc.Table(i) <> 0显示错误我不知道为什么,我不是经验丰富的 VBA 编码员。如果您有解决方案,请帮助我!

Sub copieTableauWordVersExcel()
'nécéssite d'activer la référence Microsoft Word xx.x Object Library

Dim WordApp As Word.Application
Dim WordDoc As Word.Document
Dim Fichier As String
Dim i As Integer

'le document Word est supposé fermé avant le lancement de la macro
Fichier = "C:\Users\429093\Desktop\ME.docx" 'adapter le chemin
Set WordApp = CreateObject("Word.Application") 'creation session Word

WordApp.Visible = False 'pour que word reste masqué pendant l'opération
Set WordDoc = WordApp.Documents.Open(Fichier) 'ouverture du fichier Word

i = 1

While WordDoc.Table(i) <> 0
   WordDoc.Tables(i).Range.copy 'copie du tableau Word
   'dans Word chaque tableau est indexé
   'ici l'index est à 2 car le premier index correspond au cadre autour du titre du
   'document Word
   i = i + 1
Wend

Range("A1").Select
ActiveSheet.Paste 'collage des données dans Excel
WordDoc.Close False 'ferme le document Word sans sauvegarde
WordApp.Quit 'ferme l'application Word

End Sub

解决方法

您的代码有两个问题。首先,您所拥有的不会选取文档中的所有表格,而另外两个您只会将结果粘贴到 Excel 文档中的一个单元格中。这意味着即使您有一个适当的循环来执行和复制所有表,它们也会被粘贴到工作表中另一个的顶部。

尝试这样的事情......

For i = 1 to WordDoc.Tables.Count
    WordDoc.Tables(i).Range.Copy
    Range("A" & i).Select
    ActiveSheet.Paste
Next