我正在尝试使用VB宏将一些数据从word表复制到excel表.
它根据需要完美地复制文本.
现在我想保留word doc中存在的源格式.
我想保留的东西是
>罢工
>颜色
>子弹
>新线字符
我使用以下代码进行复制 –
objTemplateSheetExcelSheet.Cells(1,2)= WorksheetFunction.Clean(.cell(iRow,iCol).Range.Text)
请告诉我如何编辑它以保留源格式.
我使用的逻辑如下 –
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
我在word文件上运行表计数.然后,对于使用上述代码访问表的每一行和每列的单词doc中存在的所有表.
好的,我也附上了剩余的代码
'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
要从Excel与Word交互,您可以选择早期绑定或晚期绑定.我正在使用Late Binding,您不需要添加任何引用.
我将以5个部分介绍代码
>使用Word实例绑定
>打开Word文档
>与Word表交互
>声明Excel对象
>将单词表复制到Excel
A.与Word实例绑定
声明您的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.打开Word文档
连接/创建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.与Word表交互
现在你打开了文档,让我们连接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*),"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.声明Excel对象
现在我们有了Word表格的句柄.在我们复制它之前,让我们设置我们的Excel对象.
Sub Sample() Dim oWordApp As Object,"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.将单词表复制到Excel
最后,当我们将目标设置为全部时,只需将表格从单词复制到Excel即可.看到这个.
Sub Sample() Dim oWordApp As Object,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
屏幕截图
Word文档
Excel(粘贴后)
希望这可以帮助.