Excel это не сложно
Добро пожаловать, Гость. Пожалуйста, войдите или зарегистрируйтесь.
18.04.2024, 23:00:30

Войти
Название темы должно отражать её содержание.
Темы типа "ПОМОГИТЕ!!!", "Срочно!", "Не получается сделать", "Нужна помощь" и т.п. будут удаляться без объяснения причин
33 242 Сообщений в 5 457 Тем от 6 758 Пользователей
Последний пользователь: Сергей2662
*
Перейти на сайт Хитрости Надстройка MulTEx Обучающие тренинги Наша группа ВКонтакте
Правила форума Начало Помощь Поиск Календарь Войти Регистрация Выйти
+  Excel это не сложно
|-+  Основные форумы
| |-+  Вопросы по Excel и VBA
| | |-+  Извлечь данные из таблицы Word с переносом строк
Страниц: [1]   Вниз
Печать
Автор Тема: Извлечь данные из таблицы Word с переносом строк  (Прочитано 2788 раз)
0 Пользователей и 1 Гость смотрят эту тему.
Samyrro054
Новичок
*

Репутация: +0/-0
Офлайн Офлайн

Сообщений: 6


Просмотр профиля E-mail
« : 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
Записан
Дмитрий Щербаков(The_Prist)
Администратор
Ветеран
*****

Репутация: +485/-0
Офлайн Офлайн

Сообщений: 5 831



Просмотр профиля WWW
« Ответ #1 : 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
Записан

Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
Пункты приёма Спасибов:    -41001332272872  -R298726502453
Страниц: [1]   Вверх
Печать
Перейти в:  

Powered by MySQL Powered by PHP Powered by SMF 1.1.21 | SMF © 2006-2011, Simple Machines Valid XHTML 1.0! Valid CSS!
Яндекс.Метрика Рейтинг@Mail.ru