Excel это не сложно

Основные форумы => Вопросы по Excel и VBA => Тема начата: Samyrro054 от 14.11.2019, 10:50:16



Название: Извлечь данные из таблицы Word с переносом строк
Отправлено: Samyrro054 от 14.11.2019, 10:50:16
Здравствуйте! Существует таблица Word, в которой каждая новая строка не является новой ячейкой, а просто перенос строки (Enter-ом создавали новую строку).
Я пытаюсь извлечь все строки таблицы в ячейки Excel. Но поскольку этой не обычный перебор строк таблицы циклом, необходима помощь в создании макроса, который сможет выделить текст до переноса строки, записать его в ячейку Excel и т.д. в цикле каждую новую строку. Такое вообще реально сделать?
Вот код для подключения к документу Word:

Код: (vb)
Sub OpenWord()
    Dim objWrdApp As Object, objWrdDoc As Object, avFiles, i As Integer, tbl As Object
    avFiles = Application.GetOpenFilename _
                ("Word files(*.doc*),*.do*", 1, "Выберите таблицу", , False)
    If VarType(avFiles) = vbBoolean Then
        Exit Sub
    End If
        Set objWrdApp = CreateObject("Word.Application")
        objWrdApp.Visible = False
        Set objWrdDoc = objWrdApp.Documents.Open(avFiles)
        Set tbl = objWrdDoc.Tables(1)
        ActiveSheet.Cells(1, 1) = tbl.Cell(2, 1).Range.text       
        objWrdDoc.Close True
        objWrdApp.Quit
        Set objWrdDoc = Nothing: Set objWrdApp = Nothing
End Sub


Название: Re:Извлечь данные из таблицы Word с переносом строк
Отправлено: Дмитрий Щербаков(The_Prist) от 14.11.2019, 12:46:21
А так не подойдет?
Код: (vb)
Sub OpenWord()
    Dim objWrdApp As Object, objWrdDoc As Object, avFiles, i As Integer, tbl As Object
    avFiles = Application.GetOpenFilename _
                ("Word files(*.doc*),*.do*", 1, "Выберите таблицу", , False)
    If VarType(avFiles) = vbBoolean Then
        Exit Sub
    End If
        Set objWrdApp = CreateObject("Word.Application")
        objWrdApp.Visible = False
        Set objWrdDoc = objWrdApp.Documents.Open(avFiles)
        Set tbl = objWrdDoc.Tables(1)
        tbl.Range.Copy
        ActiveSheet.Paste
        Selection.ClearFormats
        objWrdDoc.Close True
        objWrdApp.Quit
        Set objWrdDoc = Nothing: Set objWrdApp = Nothing
End Sub