简体   繁体   中英

How to export the data from excel to word as text use VBA

I have the following code found from this web site. It works almost, except that it export the date into a form in Word document. Instead, I would like to have paragraphs, keeping the original font, size and color in excel. Could anyone help? Very much appreciated!

Sub Export_Excel_To_Word()

Dim wdApp As Object
Dim wd As Object

On Error Resume Next
Set wdApp = GetObject(, "Word.Application")
If Err.Number <> 0 Then
    Set wdApp = CreateObject("Word.Application")
End If
On Error GoTo 0

Set wd = wdApp.Documents.Add

wdApp.Visible = True



Sheets("sheet1").Activate
Set Rng = ThisWorkbook.ActiveSheet.Range("A2:F21")

Rng.Copy

   With wd.Range
        .Collapse Direction:=wdCollapseStart                  'Slutet av dokumentet
        .InsertParagraphAfter                                 'Lagg till rad
        .Collapse Direction:=wdCollapseStart                  'Slutet av dokumentet
        .PasteSpecial xlPasteFormats, False, False            'Paste with format

    End With

End Sub

It's pretty simple, you're using the pasteSpecial method with misplaced parameters. That induced me in error in the beginning. Try this to paste pure unformatted text:

.PasteSpecial DataType:=2 ' wdPasteDataType.wdPasteText

Or to keep the formats of fonts,

.PasteSpecial DataType:=1 ' wdPasteDataType.wdPasteRtf

To replace the tabs with single space after the paste:

With wd.Range
    .Collapse Direction:=wdCollapseStart
    .InsertParagraphAfter
    .Collapse Direction:=wdCollapseStart
    .PasteSpecial DataType:=2
    With .Find
        .ClearFormatting
        .Text = vbTab
        .Replacement.ClearFormatting
        .Replacement.Text = " "
        .Execute Replace:=wdReplaceAll, Forward:=True, Wrap:=wdFindContinue
    End With
End With

The easiest alternative that I can think of is to paste the Excel Range and convert the table to text:

ThisWorkbook.Sheets("sheet1").Range("A2:F21").Copy

wdApp.Selection.Paste

wdApp.DefaultTableSeparator = " "

wdApp.Selection.Previous(15).Rows.ConvertToText 

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM