使用VB宏将数据从word表复制到excel表格时如何保留源格式？ [英] How to preserve source formatting while copying data from word table to excel sheet using VB macro?

查看：2448 发布时间：2017/9/3 18:20:06 excel vba excel-vba ms-word

本文介绍了使用VB宏将数据从word表复制到excel表格时如何保留源格式？的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！

问题描述

我正在尝试使用VB宏将一个单词表中的一些数据复制到excel表。

现在我想保留word文档中的源格式。

我想保存的东西是

打击

颜色

项目符号

新行字符

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

objTemplateSheetExcelSheet.Cells（1，2）= WorksheetFunction.Clean（.cell（iRow，iCol）.Range.Text）

请允许我知道如何编辑它，以便保留源格式。

我使用的逻辑如下 - / p>

  wdFileName = Application.GetOpenFilename（Word文件（*。*），*。*，_ 
浏览包含要导入的表的文件）'（浏览文件）
 
如果wdFileName = False然后Exit Sub'（用户已取消的impor t文件浏览器）
 
设置wdDoc = GetObject（wdFileName）'（打开Word文件）
 
用wdDoc 
'在这里输入代码
 TableNo = wdDoc.tables.Count'（对文档中的表进行计数）
如果TableNo = 0则
 MsgBox此文档不包含表，_ 
 vbExclamation，导入Word表
结束如果
结束

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

确定我附加了剩余的代码段

 '创建TemplateSheet对象
设置objTemplateSheetExcelApp = CreateObject（Excel.Application）
'打开要使用的模板
 objTemplateSheetExcelApp.Workbooks.Open（C：\Temp\Documents页面XX_US-VC组合Template.xlsx）
设置objTemplateSheetExcelWkBk = objTemplateSheetExcelApp.ActiveWorkbook.Worksheets（5）
设置objTemplateSheetExcelSheet = objTemplateSheetExcelApp.ActiveWorkbook.Worksheets（5）'（选择所需的选项卡）
 
 tblcount = 1 
对于tblcount = 1 To TableNo 
 With .tables（tblcount ）
'将单元格内容从Word表格单元格复制到Excel单元格
对于iRow = 1 To .Rows.Count 
对于iCol = 1 To .Columns.Count 
 On Error Resume Next 
 strEach = Worksh eetFunction.Clean（.cell（iRow，iCol）.Range.Text）
对于arrycnt = 0到15 
 YNdoc = InStr（strEach，myArray（arrycnt））
 If（YNdoc> 0）然后
 objTemplateSheetExcelSheet.Cells（2，yourArray（arrycnt））= _ 
 WorksheetFunction.Clean（.cell（iRow，iCol + 1）.Range.Text）
如果arrycnt = 3或者arrycnt = 6然后
 objTemplateSheetExcelSheet.Cells（2，yourArray（arrycnt）+ 1）= _ 
 WorksheetFunction.Clean（.cell（iRow + 1，iCol + 1）.Range.Text）
结束如果
结束如果
下一步arrycnt 
下一步iCol 
下一步iRow 
结束
下一个tblcount 
结束
 intRow = 1 
 
'保存文件
 strFileName =Newfile.xlsx
 objTemplateSheetExcelWkBk.SaveAs strFld& \& strFileName 
 
 objTemplateSheetExcelApp.Quit 
 
设置objTemplateSheetExcelApp = Nothing 
设置objTemplateSheetExcelWkBk = Nothing 
设置objTemplateSheetExcelSheet = Nothing 
 
设置wdDoc =没有

解决方案

要与Excel进行交互，您可以选择早期绑定或延迟绑定。我正在使用Late Binding，您不需要添加任何参考。

我将在5部分中包含代码

使用Word实例绑定

打开Word文档

与Word表格交互

声明Excel对象

将单词表复制到Excel

A。使用Word实例绑定

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

  Sub Sample（）
 Dim oWordApp As Object，oWordDoc As Object 
 
 ~~>建立Word应用程序对象
 On Error Resume Next 
设置oWordApp = GetObject（，Word.Application）
 
如果Err.Number<> 0然后
设置oWordApp = CreateObject（Word.Application）
结束如果
 Err.Clear 
错误GoTo 0 
 
 oWordApp.Visible =真
 End Sub

B。打开Word文档

一旦连接/创建了Word实例，只需打开word文件。示例

  Sub Sample（）
 Dim oWordApp As Object，oWordDoc As Object 
 Dim FlName As String 
 
 FlName = Application.GetOpenFilename（Word文件（* .Doc *），*。Doc *，，_ 
浏览要导入的表的文件）
 
'~~>建立Word应用程序对象
 On Error Resume Next 
设置oWordApp = GetObject（，Word.Application）
 
如果Err.Number<> 0然后
设置oWordApp = CreateObject（Word.Application）
结束如果
 Err.Clear 
错误GoTo 0 
 
 oWordApp.Visible = True 
 
'~~>打开Word文档
设置oWordDoc = oWordApp.Documents.Open（FlName）
 End Sub

C。与Word表格交互

现在您打开文档，让我们连接到word文档中的Table1。 >

  Sub Sample（）
 Dim oWordApp As Object，oWordDoc As Object 
 Dim FlName As String 
 Dim tbl As Object 
 
 FlName = Application.GetOpenFilename（Word文件（* .Doc *），*。Doc *，_ 
浏览要导入的文件包含表） 
 
'~~>建立Word应用程序对象
 On Error Resume Next 
设置oWordApp = GetObject（，Word.Application）
 
如果Err.Number<> 0然后
设置oWordApp = CreateObject（Word.Application）
结束如果
 Err.Clear 
错误GoTo 0 
 
 oWordApp.Visible = True 
 
设置oWordDoc = oWordApp.Documents.Open（FlName）
 
设置tbl = oWordDoc.Tables（1）
 End Sub

D。声明您的Excel对象

现在我们有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 *，，_ 
浏览要导入的包含表的文件）
 
'~~>建立Word应用程序对象
 On Error Resume Next 
设置oWordApp = GetObject（，Word.Application）
 
如果Err.Number<> 0然后
设置oWordApp = CreateObject（Word.Application）
结束如果
 Err.Clear 
错误GoTo 0 
 
 oWordApp.Visible = True 
 
设置oWordDoc = oWordApp.Documents.Open（FlName）
 
设置tbl = oWordDoc.Tables（1）
 
'~~> Excel对象
 Dim wb As Workbook，ws As Worksheet 
 
设置wb = Workbooks.Open（C：\Temp\Documents Page XX_US-VC Combo Template.xlsx）
 
设置ws = wb.Sheets（5）
 End Sub

E。将单词表复制到Excel

最后，当我们将目标全部设置后，只需将表从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 *，，_ 
浏览包含表要导入）
 
'~~>建立Word应用程序对象
 On Error Resume Next 
设置oWordApp = GetObject（，Word.Application）
 
如果Err.Number<> 0然后
设置oWordApp = CreateObject（Word.Application）
结束如果
 Err.Clear 
错误GoTo 0 
 
 oWordApp.Visible = True 
 
设置oWordDoc = oWordApp.Documents.Open（FlName）
 
设置tbl = oWordDoc.Tables（1）
 
'~~> Excel对象
 Dim wb As Workbook，ws As Worksheet 
 
设置wb = Workbooks.Open（C：\Temp\Documents Page XX_US-VC Combo Template.xlsx）
 
设置ws = wb.Sheets（1）
 
 tbl.Range.Copy 
 
 ws.Range（A1）。激活
 
 ws.Paste 
 End Sub

SCREENSHOT

Word文档

Excel

希望这有帮助。

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

It is copying the text perfectly as desired.

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

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)

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.

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

解决方案

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.

I will cover the code in 5 parts

Binding with a Word Instance
Opening the Word document
Interacting with Word Table
Declaring Your Excel Objects
Copying the word table to 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

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

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

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

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

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

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

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

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

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

Excel (After Pasting)

Hope this helps.

这篇关于使用VB宏将数据从word表复制到excel表格时如何保留源格式？的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！

查看全文

使用VB宏将数据从word表复制到excel表格时如何保留源格式？ [英] How to preserve source formatting while copying data from word table to excel sheet using VB macro?

问题描述

请允许我知道如何编辑它，以便保留源格式。

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

相关文章

Office最新文章

热门教程

热门工具

登录关闭

使用VB宏将数据从word表复制到excel表格时如何保留源格式？ [英] How to preserve source formatting while copying data from word table to excel sheet using VB macro?

问题描述

请允许我知道如何编辑它，以便保留源格式。

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

相关文章

Office最新文章

热门教程

热门工具

登录 关闭

登录关闭