如何在使用VB宏复制word表格到excel表时保存源格式?

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文档中的源格式。

The things I want to preserve are

我想保存的东西是。

Strike Through
删去
Color
颜色
Bullets
子弹
New Line Character
新行字符

I am using the following code to copy -

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

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

objTemplateSheetExcelSheet。(1、2)= WorksheetFunction.Clean(细胞。细胞(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文档中的所有表。

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

1 个解决方案

#1

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个部分。

Binding with a Word Instance
绑定一个单词实例。
Opening the Word document
打开Word文档
Interacting with Word Table
互动与词表
Declaring Your Excel Objects
宣布Excel对象
Copying the word table to Excel
复制word表格到Excel中。

A. Binding with a Word Instance

与一个单词实例绑定。

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

声明您的单词对象，然后绑定一个现有的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文件。看这个例子

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表交互。

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

声明你的Excel对象。

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

现在我们有了单词表的句柄。在复制之前，让我们设置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

复制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