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

我正在尝试使用VB宏将一些数据从word表复制到excel表. @H_404_1@它根据需要完美地复制文本.

@H_404_1@现在我想保留word doc中存在的源格式.

@H_404_1@我想保留的东西是

@H_404_1@>罢工
>颜色
>子弹
>新线字符

@H_404_1@我使用以下代码进行复制 –

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

@H_404_1@请告诉我如何编辑它以保留源格式.

@H_404_1@我使用的逻辑如下 –

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

@H_404_1@我在word文件上运行表计数.然后,对于使用上述代码访问表的每一行和每列的单词doc中存在的所有表.

@H_404_1@好的,我也附上了剩余的代码

'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,您不需要添加任何引用. @H_404_1@我将以5个部分介绍代码

@H_404_1@>使用Word实例绑定
>打开Word文档
>与Word表交互
>声明Excel对象
>将单词表复制到Excel

@H_404_1@A.与Word实例绑定

@H_404_1@声明您的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

@H_404_1@B.打开Word文档

@H_404_1@连接/创建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

@H_404_1@C.与Word表交互

@H_404_1@现在你打开了文档,让我们连接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

@H_404_1@D.声明Excel对象

@H_404_1@现在我们有了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

@H_404_1@E.将单词表复制到Excel

@H_404_1@最后,当我们将目标设置为全部时,只需将表格从单词复制到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

@H_404_1@屏幕截图

@H_404_1@Word文档

@H_404_1@Excel(粘贴后)

@H_404_1@希望这可以帮助.

原文链接：https://www.f2er.com/vb/255912.html

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

猜你在找的VB相关文章