Домашняя страница Undo Do Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Извлечь данные из таблицы Word с переносом строк - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, Manyasha, SLAVICK, китин  
Мир MS Excel » Вопросы и решения » Excel и другие приложения » Word » Извлечь данные из таблицы Word с переносом строк (Макросы/Sub)
Извлечь данные из таблицы Word с переносом строк
Samyrro054 Дата: Четверг, 14.11.2019, 10:42 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 1
Репутация: 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
 
Ответить
СообщениеЗдравствуйте! Существует таблица 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]

Автор - Samyrro054
Дата добавления - 14.11.2019 в 10:42
китин Дата: Четверг, 14.11.2019, 10:56 | Сообщение № 2
Группа: Модераторы
Ранг: Экселист
Сообщений: 5977
Репутация: 928 ±
Замечаний: 0% ±

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


Не судите строго:я пытаюсь научиться
ЯД 41001877306852/WM R249698041931; Z239672726538
 
Ответить
СообщениеSamyrro054, - Прочитайте Правила форума
- Оформите код тегами (в режиме правки поста выделите код и нажмите кнопку #, пояснялка здесь)

Автор - китин
Дата добавления - 14.11.2019 в 10:56
Pelena Дата: Четверг, 14.11.2019, 18:46 | Сообщение № 3
Группа: Админы
Ранг: Местный житель
Сообщений: 14887
Репутация: 3251 ±
Замечаний: ±

Excel 2010, 2016 & 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]


"Черт возьми, Холмс! Но как??!!"
ЯД 41001765434816
 
Ответить
СообщениеА если просто скопировать?
[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]

Автор - Pelena
Дата добавления - 14.11.2019 в 18:46
Мир MS Excel » Вопросы и решения » Excel и другие приложения » Word » Извлечь данные из таблицы Word с переносом строк (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс цитирования
© 2010-2019 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!