Как я могу импортировать таблицу слов в Excel и продолжить форматирование?

Question

Я хочу импортировать таблицу слов в Excel и сохранить форматирование; образец текста.

ЗДЕСЬ НЕКОТОРЫЙ ОБРАЗЕЦ ТЕКСТА

БОЛЬШЕ ТЕКСТА БОЛЬШЕ ТЕКСТА

MORETEXT

Приведенный выше текст находится в одной ячейке таблицы слов, но когда я импортирую в Excel, он помещает этот текст в три отдельные ячейки. Мне нужно импортировать таблицу слов (то есть, эту ячейку слов) в Excel в одной ячейке.

Не все мои ячейки / строки отформатированы таким образом. Но некоторые есть. Так что, если бы я мог использовать формат таблицы слов непосредственно в Excel, это было бы идеально.

Извините, если это сбивает с толку, был бы рад уточнить

Спасибо

Вот код, который я сейчас использую:

Sub ImportWordTable()
Dim wdDoc As Object
Dim wdFileName As Variant
Dim TableNo As Integer 'table number in Word
Dim iRow As Long 'row index in Excel
Dim iCol As Integer 'column index in Excel

wdFileName = Application.GetOpenFilename("Word files ,*.doc;*.docx;*.docm", , _
"Browse for file containing table to be imported")

If wdFileName = False Then Exit Sub '(user cancelled import file browser)

Set wdDoc = GetObject(wdFileName) 'open Word file

With wdDoc
    TableNo = wdDoc.TAbles.Count
    If TableNo = 0 Then
        MsgBox "This document contains no tables", _
        vbExclamation, "Import Word Table"
    ElseIf TableNo > 1 Then
        TableNo = InputBox("This Word document contains " & TableNo & " tables." & vbCrLf & _
        "Enter table number of table to import", "Import Word Table", "1")
    End If
    With .TAbles(TableNo).Range.Copy
Range("A1").Activate
Application.CommandBars.ExecuteMso "PasteSourceFormatting"
    End With
End With

Set wdDoc = Nothing

End Sub

Answer 1

Это должно делать то, что вы хотите.

Sub WordToExcel()
Dim wdApp As Word.Application
Dim wdDoc As Word.Document
Dim x As Integer
Dim strFilename As String
Dim strFolder As String
Dim temp As String

Set wdApp = New Word.Application
'initialise counter
x = 1
'search for first file in directory
strFolder = "C:\Users\Excel\Desktop\test\"
strFilename = Dir(strFolder & "*.doc")
'amemd folder name
Do While strFilename <> ""
Set wdDoc = wdApp.Documents.Open(strFolder & strFilename)
temp = wdDoc.Tables(1).Cell(2, 1).Range.Text 'read word cell
Range("A2").Offset(x, 0) = temp
temp = wdDoc.Tables(1).Cell(2, 2).Range.Text 'read word cell
Range("A2").Offset(x, 1) = temp
'etc
temp = wdDoc.Tables(1).Cell(2, 3).Range.Text 'read word cell
Range("A2").Offset(x, 2) = temp
temp = wdDoc.Tables(1).Cell(2, 4).Range.Text 'read word cell
Range("A2").Offset(x, 3) = temp

wdDoc.Close
x = x + 1
strFilename = Dir
Loop
wdApp.Quit
Set wdDoc = Nothing
Set wdApp = Nothing
End Sub