vba 使用VB宏将数据从word表复制到excel表时如何保留源格式？

How to preserve source formatting while copying data from word table to excel sheet using VB macro?

提问by user1643371

I am trying to copy some data from a word table to an excel sheet using a VB Macro.

我正在尝试使用 VB 宏将一些数据从 Word 表复制到 Excel 表。

It is copying the text perfectly as desired.

它正在根据需要完美地复制文本。

Now i want to preserve the source formatting present in word doc.

现在我想保留 word doc 中存在的源格式。

The things I want to preserve are

我想保留的东西是

1. Strike Through
2. Color
3. Bullets
4. New Line Character

1. 击穿
2. 颜色
3. 子弹
4. 换行符

I am using the following code to copy -

我正在使用以下代码进行复制 -

objTemplateSheetExcelSheet.Cells(1, 2) = WorksheetFunction.Clean(.cell(iRow, iCol).Range.Text)

objTemplateSheetExcelSheet.Cells(1, 2) = WorksheetFunction.Clean(.cell(iRow, iCol).Range.Text)

Kindly let me know how I can edit this so as to preserve source formatting.

请让我知道如何编辑它以保留源格式。

The logic I am using is as follows -

我使用的逻辑如下 -

wdFileName = Application.GetOpenFilename("Word files (*.*),*.*", , _
"Browse for file containing table to be imported") '(Browsing for a file)

If wdFileName = False Then Exit Sub '(user cancelled import file browser)

Set wdDoc = GetObject(wdFileName) '(open Word file)

With wdDoc
    'enter code here`
    TableNo = wdDoc.tables.Count '(Counting no of tables in the document)
    If TableNo = 0 Then
        MsgBox "This document contains no tables", _
        vbExclamation, "Import Word Table"
    End If
End With

I am running a table count on the word file. Then for all the tables present in the word doc accessing each row and column of the tables using the above mentioned code.

我正在对 word 文件运行表计数。然后对于 word doc 中存在的所有表格，使用上述代码访问表格的每一行和每一列。

Ok I am attaching the remaining piece of code as well

好的，我也附上了剩余的代码

'Creating TemplateSheet object
Set objTemplateSheetExcelApp = CreateObject("Excel.Application")
'Opening the template to be used
objTemplateSheetExcelApp.Workbooks.Open ("C:\Temp\Documents Page XX_US-VC Combo Template.xlsx")
Set objTemplateSheetExcelWkBk = objTemplateSheetExcelApp.ActiveWorkbook.Worksheets(5)
Set objTemplateSheetExcelSheet = objTemplateSheetExcelApp.ActiveWorkbook.Worksheets(5) '(Selecting the desired tab)

tblcount = 1
For tblcount = 1 To TableNo
    With .tables(tblcount)
    'copy cell contents from Word table cells to Excel cells
    For iRow = 1 To .Rows.Count
        For iCol = 1 To .Columns.Count
            On Error Resume Next
            strEach = WorksheetFunction.Clean(.cell(iRow, iCol).Range.Text)
            For arrycnt = 0 To 15
                YNdoc = InStr(strEach, myArray(arrycnt))
                    If (YNdoc > 0) Then
                        objTemplateSheetExcelSheet.Cells(2, yourArray(arrycnt)) = _
                        WorksheetFunction.Clean(.cell(iRow, iCol + 1).Range.Text)
                            If arrycnt = 3 Or arrycnt = 6 Then
                                objTemplateSheetExcelSheet.Cells(2, yourArray(arrycnt) + 1) = _
                                WorksheetFunction.Clean(.cell(iRow + 1, iCol + 1).Range.Text)
                            End If
                    End If
            Next arrycnt
        Next iCol
    Next iRow
    End With
    Next tblcount
End With
intRow = 1

'To save the file
strFileName = "Newfile.xlsx"
objTemplateSheetExcelWkBk.SaveAs strFld & "\" & strFileName

objTemplateSheetExcelApp.Quit

Set objTemplateSheetExcelApp = Nothing
Set objTemplateSheetExcelWkBk = Nothing
Set objTemplateSheetExcelSheet = Nothing

Set wdDoc = Nothing

回答by Siddharth Rout

To interact with Word from Excel, you can choose either Early Binding or Late Binding. I am using Late Binding where you do not need to add any references.

要从 Excel 与 Word 交互，您可以选择早期绑定或后期绑定。我正在使用后期绑定，您不需要添加任何引用。

I will cover the code in 5 parts

我将分 5 部分介绍代码

1. Binding with a Word Instance
2. Opening the Word document
3. Interacting with Word Table
4. Declaring Your Excel Objects
5. Copying the word table to Excel

1. 与 Word 实例绑定
2. 打开 Word 文档
3. 与 Word Table 交互
4. 声明你的 Excel 对象
5. 将word表格复制到Excel

---

---

A. Binding with a Word Instance

A. 使用 Word 实例绑定

---

---

Declare your Word objects and then bind with either an existing instance of Word or create a new instance. For example

声明您的 Word 对象，然后与 Word 的现有实例绑定或创建一个新实例。例如

Sub Sample()
    Dim oWordApp As Object, oWordDoc As Object

    '~~> Establish an Word application object
    On Error Resume Next
    Set oWordApp = GetObject(, "Word.Application")

    If Err.Number <> 0 Then
        Set oWordApp = CreateObject("Word.Application")
    End If
    Err.Clear
    On Error GoTo 0

    oWordApp.Visible = True
End Sub

---

---

B. Opening the Word document

B. 打开 Word 文档

---

---

Once you have connected with/created the Word instance, simply open the word file.. See this example

一旦你连接/创建了 Word 实例，只需打开 word 文件.. 看这个例子

Sub Sample()
    Dim oWordApp As Object, oWordDoc As Object
    Dim FlName As String

    FlName = Application.GetOpenFilename("Word files (*.Doc*),*.Doc*", , _
             "Browse for file containing table to be imported")

    '~~> Establish an Word application object
    On Error Resume Next
    Set oWordApp = GetObject(, "Word.Application")

    If Err.Number <> 0 Then
        Set oWordApp = CreateObject("Word.Application")
    End If
    Err.Clear
    On Error GoTo 0

    oWordApp.Visible = True

    '~~> Open the Word document
    Set oWordDoc = oWordApp.Documents.Open(FlName)
End Sub

---

---

C. Interacting with Word Table

C. 与 Word Table 交互

---

---

Now you have the document open, Let's connect with say Table1 of the word document.

现在你已经打开了文档，让我们连接 word 文档的 Table1。

Sub Sample()
    Dim oWordApp As Object, oWordDoc As Object
    Dim FlName As String
    Dim tbl As Object

    FlName = Application.GetOpenFilename("Word files (*.Doc*),*.Doc*", , _
             "Browse for file containing table to be imported")

    '~~> Establish an Word application object
    On Error Resume Next
    Set oWordApp = GetObject(, "Word.Application")

    If Err.Number <> 0 Then
        Set oWordApp = CreateObject("Word.Application")
    End If
    Err.Clear
    On Error GoTo 0

    oWordApp.Visible = True

    Set oWordDoc = oWordApp.Documents.Open(FlName)

    Set tbl = oWordDoc.Tables(1)
End Sub

---

---

D. Declaring Your Excel Objects

D. 声明你的 Excel 对象

---

---

Now we have the handle to the Word Table. Before we copy it, let's set our Excel objects.

现在我们有了 Word 表格的句柄。在我们复制它之前，让我们设置我们的 Excel 对象。

Sub Sample()
    Dim oWordApp As Object, oWordDoc As Object
    Dim FlName As String
    Dim tbl As Object

    FlName = Application.GetOpenFilename("Word files (*.Doc*),*.Doc*", , _
             "Browse for file containing table to be imported")

    '~~> Establish an Word application object
    On Error Resume Next
    Set oWordApp = GetObject(, "Word.Application")

    If Err.Number <> 0 Then
        Set oWordApp = CreateObject("Word.Application")
    End If
    Err.Clear
    On Error GoTo 0

    oWordApp.Visible = True

    Set oWordDoc = oWordApp.Documents.Open(FlName)

    Set tbl = oWordDoc.Tables(1)

    '~~> Excel Objects
    Dim wb As Workbook, ws As Worksheet

    Set wb = Workbooks.Open("C:\Temp\Documents Page XX_US-VC Combo Template.xlsx")

    Set ws = wb.Sheets(5)
End Sub

---

---

E. Copying the word table to Excel

E.复制word表格到Excel

---

---

And finally when we have the destination all set, simply copy the table from word to Excel. See this.

最后，当我们设置好目的地后，只需将表格从 Word 复制到 Excel。看到这个。

Sub Sample()
    Dim oWordApp As Object, oWordDoc As Object
    Dim FlName As String
    Dim tbl As Object

    FlName = Application.GetOpenFilename("Word files (*.Doc*),*.Doc*", , _
             "Browse for file containing table to be imported")

    '~~> Establish an Word application object
    On Error Resume Next
    Set oWordApp = GetObject(, "Word.Application")

    If Err.Number <> 0 Then
        Set oWordApp = CreateObject("Word.Application")
    End If
    Err.Clear
    On Error GoTo 0

    oWordApp.Visible = True

    Set oWordDoc = oWordApp.Documents.Open(FlName)

    Set tbl = oWordDoc.Tables(1)

    '~~> Excel Objects
    Dim wb As Workbook, ws As Worksheet

    Set wb = Workbooks.Open("C:\Temp\Documents Page XX_US-VC Combo Template.xlsx")

    Set ws = wb.Sheets(1)

    tbl.Range.Copy

    ws.Range("A1").Activate

    ws.Paste
End Sub

SCREENSHOT

截屏

Word Document

Word文档

Excel (After Pasting)

Excel（粘贴后）

Hope this helps.

希望这可以帮助。