Извлечь данные из таблицы Word с переносом строк

Старая форма входа

Страница 1 из 1 1
Модератор форума: _Boroda_, китин

Мир MS Excel » Вопросы и решения » Excel и другие приложения » Word » Извлечь данные из таблицы Word с переносом строк (Макросы/Sub)

Samyrro054

Дата: Четверг, 14.11.2019, 10:42 | Сообщение № 1

Группа: Пользователи

Ранг: Прохожий

Сообщений: 2

Репутация: 0 ±

Замечаний: 0% ±

Excel 2010

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

[vba]

Код

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

[/vba]

К сообщению приложен файл: 9966619.docx (12.8 Kb)

Сообщение отредактировал Samyrro054 - Четверг, 14.11.2019, 11:09

Ответить

китин

Дата: Четверг, 14.11.2019, 10:56 | Сообщение № 2

Группа: Модераторы

Ранг: Экселист

Сообщений: 7015

Репутация: 1073 ±

Замечаний: 0% ±

Excel 2007;2010;2016

Samyrro054, - Прочитайте Правила форума
- Оформите код тегами (в режиме правки поста выделите код и нажмите кнопку #, пояснялка здесь)

Не судите очень строго:я пытаюсь научиться
ЯД 41001877306852

Ответить

Pelena

Дата: Четверг, 14.11.2019, 18:46 | Сообщение № 3

Группа: Админы

Ранг: Местный житель

Сообщений: 19184

Репутация: 4420 ±

Замечаний: ±

Excel 365 & Mac Excel

А если просто скопировать?
[vba]

Код

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)
    objWrdApp.Visible = True
    Set tbl = objWrdDoc.Tables(1)
    tbl.Columns(1).Select
    objWrdApp.Selection.Copy
    ActiveSheet.Cells(1, 1).Select
    ActiveSheet.Paste
    'ActiveSheet.Cells(1, 1) = tbl.Cell(2, 1).Range.Text
    objWrdDoc.Close True
    objWrdApp.Quit
    Set objWrdDoc = Nothing: Set objWrdApp = Nothing
End Sub

[/vba]

"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816

Ответить

Страница 1 из 1
1