Циклическое создание таблиц в Word из Excel
SyberX
Дата: Вторник, 29.03.2016, 13:13 |
Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 4
Репутация:
0
±
Замечаний:
0% ±
Excel 2013
Добрый день! Помогите разобраться: Есть солидный список в Excel - задача преобразовать каждую строку в удобоваримую таблицу. решил пойти по такому варианту: залил таблицу Excel а массив - Arr_in [vba]Код
Set oWord = CreateObject("Word.Application") oWord.Visible = True Set oDocument = oWord.Documents.Add oDocument.ActiveWindow.ActivePane.View.Zoom.Percentage = 100 With oDocument .PageSetup.TopMargin = 25 .PageSetup.LeftMargin = 70 '.Font.Size = 11 End With For K = 1 To UBound(Arr_in) Set tbl = oDocument.Tables.Add(oDocument.Range, 16, 4) tbl.Borders.Enable = 1 tbl.Cell(K + JK, 1).Merge MergeTo:=tbl.Cell(K + JK, 4) tbl.Cell(K + JK, 1).Range.Text = "первая строка и т.д. - " + CStr(Arr_in(K, 1)) JK = JK + 1 tbl.Cell(K + JK, 1).Merge MergeTo:=tbl.Cell(K + JK, 4) tbl.Cell(K + JK, 1).Range.Text = "вторая строка и т.д. - " + CStr(Arr_in(K, 2)) wdApp.Selection.MoveDown ' по логике хотел уйти из таблицы перейти на новую страницу и создавать новую таблицу. wdApp.Selection.InsertBreak ' но эти две строки не срабатывают Next
[/vba] по логике хотел уйти из таблицы перейти на новую страницу и создавать новую таблицу. но две строки wdApp.Selection. не срабатывают. без них тоже. подскажите как быть?
Добрый день! Помогите разобраться: Есть солидный список в Excel - задача преобразовать каждую строку в удобоваримую таблицу. решил пойти по такому варианту: залил таблицу Excel а массив - Arr_in [vba]Код
Set oWord = CreateObject("Word.Application") oWord.Visible = True Set oDocument = oWord.Documents.Add oDocument.ActiveWindow.ActivePane.View.Zoom.Percentage = 100 With oDocument .PageSetup.TopMargin = 25 .PageSetup.LeftMargin = 70 '.Font.Size = 11 End With For K = 1 To UBound(Arr_in) Set tbl = oDocument.Tables.Add(oDocument.Range, 16, 4) tbl.Borders.Enable = 1 tbl.Cell(K + JK, 1).Merge MergeTo:=tbl.Cell(K + JK, 4) tbl.Cell(K + JK, 1).Range.Text = "первая строка и т.д. - " + CStr(Arr_in(K, 1)) JK = JK + 1 tbl.Cell(K + JK, 1).Merge MergeTo:=tbl.Cell(K + JK, 4) tbl.Cell(K + JK, 1).Range.Text = "вторая строка и т.д. - " + CStr(Arr_in(K, 2)) wdApp.Selection.MoveDown ' по логике хотел уйти из таблицы перейти на новую страницу и создавать новую таблицу. wdApp.Selection.InsertBreak ' но эти две строки не срабатывают Next
[/vba] по логике хотел уйти из таблицы перейти на новую страницу и создавать новую таблицу. но две строки wdApp.Selection. не срабатывают. без них тоже. подскажите как быть? SyberX
Сообщение отредактировал SyberX - Вторник, 29.03.2016, 13:29
Ответить
Сообщение Добрый день! Помогите разобраться: Есть солидный список в Excel - задача преобразовать каждую строку в удобоваримую таблицу. решил пойти по такому варианту: залил таблицу Excel а массив - Arr_in [vba]Код
Set oWord = CreateObject("Word.Application") oWord.Visible = True Set oDocument = oWord.Documents.Add oDocument.ActiveWindow.ActivePane.View.Zoom.Percentage = 100 With oDocument .PageSetup.TopMargin = 25 .PageSetup.LeftMargin = 70 '.Font.Size = 11 End With For K = 1 To UBound(Arr_in) Set tbl = oDocument.Tables.Add(oDocument.Range, 16, 4) tbl.Borders.Enable = 1 tbl.Cell(K + JK, 1).Merge MergeTo:=tbl.Cell(K + JK, 4) tbl.Cell(K + JK, 1).Range.Text = "первая строка и т.д. - " + CStr(Arr_in(K, 1)) JK = JK + 1 tbl.Cell(K + JK, 1).Merge MergeTo:=tbl.Cell(K + JK, 4) tbl.Cell(K + JK, 1).Range.Text = "вторая строка и т.д. - " + CStr(Arr_in(K, 2)) wdApp.Selection.MoveDown ' по логике хотел уйти из таблицы перейти на новую страницу и создавать новую таблицу. wdApp.Selection.InsertBreak ' но эти две строки не срабатывают Next
[/vba] по логике хотел уйти из таблицы перейти на новую страницу и создавать новую таблицу. но две строки wdApp.Selection. не срабатывают. без них тоже. подскажите как быть? Автор - SyberX Дата добавления - 29.03.2016 в 13:13
_Boroda_
Дата: Вторник, 29.03.2016, 14:04 |
Сообщение № 2
Группа: Модераторы
Ранг: Местный житель
Сообщений: 16666
Репутация:
6478
±
Замечаний:
0% ±
2003; 2007; 2010; 2013 RUS
уйти из таблицы перейти на новую страницу
Ну, если эта новая страница есть, то можно так [vba]Код
Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext
[/vba] Если страницы пока нет, то примерно так можно [vba]Код
Selection.EndKey Unit:=wdStory Selection.InsertBreak Type:=wdPageBreak
[/vba](Контрл Енд и вставка разрыва страницы)
уйти из таблицы перейти на новую страницу
Ну, если эта новая страница есть, то можно так [vba]Код
Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext
[/vba] Если страницы пока нет, то примерно так можно [vba]Код
Selection.EndKey Unit:=wdStory Selection.InsertBreak Type:=wdPageBreak
[/vba](Контрл Енд и вставка разрыва страницы)_Boroda_
Скажи мне, кудесник, любимец ба’гов... Платная помощь: Boroda_Excel@mail.ru Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
Ответить
Сообщение уйти из таблицы перейти на новую страницу
Ну, если эта новая страница есть, то можно так [vba]Код
Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext
[/vba] Если страницы пока нет, то примерно так можно [vba]Код
Selection.EndKey Unit:=wdStory Selection.InsertBreak Type:=wdPageBreak
[/vba](Контрл Енд и вставка разрыва страницы)Автор - _Boroda_ Дата добавления - 29.03.2016 в 14:04
SyberX
Дата: Вторник, 29.03.2016, 14:17 |
Сообщение № 3
Группа: Пользователи
Ранг: Прохожий
Сообщений: 4
Репутация:
0
±
Замечаний:
0% ±
Excel 2013
Selection.EndKey Unit:=wdStory Selection.InsertBreak Type:=wdPageBreak
Спасибо! новой страницы еще не создано, и результат выдает ошибку на первой строчке : Selection.EndKey Unit:=wdStory
Selection.EndKey Unit:=wdStory Selection.InsertBreak Type:=wdPageBreak
Спасибо! новой страницы еще не создано, и результат выдает ошибку на первой строчке : Selection.EndKey Unit:=wdStorySyberX
Ответить
Сообщение Selection.EndKey Unit:=wdStory Selection.InsertBreak Type:=wdPageBreak
Спасибо! новой страницы еще не создано, и результат выдает ошибку на первой строчке : Selection.EndKey Unit:=wdStoryАвтор - SyberX Дата добавления - 29.03.2016 в 14:17
zopa
Дата: Вторник, 29.03.2016, 14:30 |
Сообщение № 4
Группа: Пользователи
Ранг: Прохожий
Сообщений: 6
Репутация:
0
±
Замечаний:
100% ±
Excel 2010
по логике хотел уйти из таблицы перейти на новую страницу и создавать новую таблицу. но две строки wdApp.Selection. не срабатывают. без них тоже. подскажите как быть?
wdApp нигде не определено. Скорее всего там должно быть oWord. Но проблема в любом случае не в этом.
по логике хотел уйти из таблицы перейти на новую страницу и создавать новую таблицу. но две строки wdApp.Selection. не срабатывают. без них тоже. подскажите как быть?
wdApp нигде не определено. Скорее всего там должно быть oWord. Но проблема в любом случае не в этом.zopa
Ответить
Сообщение по логике хотел уйти из таблицы перейти на новую страницу и создавать новую таблицу. но две строки wdApp.Selection. не срабатывают. без них тоже. подскажите как быть?
wdApp нигде не определено. Скорее всего там должно быть oWord. Но проблема в любом случае не в этом.Автор - zopa Дата добавления - 29.03.2016 в 14:30
_Boroda_
Дата: Вторник, 29.03.2016, 14:30 |
Сообщение № 5
Группа: Модераторы
Ранг: Местный житель
Сообщений: 16666
Репутация:
6478
±
Замечаний:
0% ±
2003; 2007; 2010; 2013 RUS
Ну ясен пень, я же дал Вам код Ворда, а Вы его из Excel запускаете. У Вас объект Ворда oWord, вот туда все это и суйте.
Ну ясен пень, я же дал Вам код Ворда, а Вы его из Excel запускаете. У Вас объект Ворда oWord, вот туда все это и суйте. _Boroda_
Скажи мне, кудесник, любимец ба’гов... Платная помощь: Boroda_Excel@mail.ru Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
Ответить
Сообщение Ну ясен пень, я же дал Вам код Ворда, а Вы его из Excel запускаете. У Вас объект Ворда oWord, вот туда все это и суйте. Автор - _Boroda_ Дата добавления - 29.03.2016 в 14:30
SyberX
Дата: Вторник, 29.03.2016, 14:39 |
Сообщение № 6
Группа: Пользователи
Ранг: Прохожий
Сообщений: 4
Репутация:
0
±
Замечаний:
0% ±
Excel 2013
wdApp нигде не определено. Скорее всего там должно быть oWord. Но проблема в любом случае не в этом.
Спасибо! Действительно скопировал из другого места, а объект не определил. Ну ясен пень, я же дал Вам код Ворда, а Вы его из Excel запускаете.
Благодарю! Кажется разобрался)
wdApp нигде не определено. Скорее всего там должно быть oWord. Но проблема в любом случае не в этом.
Спасибо! Действительно скопировал из другого места, а объект не определил. Ну ясен пень, я же дал Вам код Ворда, а Вы его из Excel запускаете.
Благодарю! Кажется разобрался)SyberX
Ответить
Сообщение wdApp нигде не определено. Скорее всего там должно быть oWord. Но проблема в любом случае не в этом.
Спасибо! Действительно скопировал из другого места, а объект не определил. Ну ясен пень, я же дал Вам код Ворда, а Вы его из Excel запускаете.
Благодарю! Кажется разобрался)Автор - SyberX Дата добавления - 29.03.2016 в 14:39
SyberX
Дата: Вторник, 29.03.2016, 15:50 |
Сообщение № 7
Группа: Пользователи
Ранг: Прохожий
Сообщений: 4
Репутация:
0
±
Замечаний:
0% ±
Excel 2013
Проблему решил вот таким образом [vba]Код
Dim Arr_in() ' Set oWord = CreateObject("Word.Application") oWord.Visible = True Set oDocument = oWord.Documents.Add oDocument.ActiveWindow.ActivePane.View.Zoom.Percentage = 100 With oDocument .PageSetup.TopMargin = 25 .PageSetup.LeftMargin = 70 '.Font.Size = 11 End With lLastRow = Cells(Rows.Count, 2).End(xlUp).Row TxtLastRow = CStr(lLastRow) Arr_in() = Range("A1:Y6" + TxtLastRow) JK = 1 lo = 0 For K = 1 To UBound(Arr_in) 'Set tbl = oDocument.Tables.Add(oDocument.Range, 16, 4) 'tbl.Borders.Enable = 1 Lo = oDocument.Paragraphs.Count oDocument.Tables.Add Range:=oDocument.Paragraphs(lo).Range, NumRows:=2, NumColumns _ :=4, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _ wdAutoFitWindow Set tbl = oDocument.Tables(K) tbl.Borders.Enable = 1 tbl.Cell(JK, 1).Merge MergeTo:=tbl.Cell(JK, 4) tbl.Cell(JK, 1).Range.Text = "ïåðâàÿ ñòðîêà è ò.ä. - " + CStr(Arr_in(K, 1)) JK = JK + 1 tbl.Cell(JK, 1).Merge MergeTo:=tbl.Cell(JK, 4) tbl.Cell(JK, 1).Range.Text = "âòîðàÿ ñòðîêà è ò.ä. - " + CStr(Arr_in(K, 2)) tbl.Cell(K + JK, 1).Select oWord.Selection.MoveDown oWord.Selection.InsertBreak JK = 1 Set tbl = Nothing Next
[/vba] Еще раз всем спасибо!
Проблему решил вот таким образом [vba]Код
Dim Arr_in() ' Set oWord = CreateObject("Word.Application") oWord.Visible = True Set oDocument = oWord.Documents.Add oDocument.ActiveWindow.ActivePane.View.Zoom.Percentage = 100 With oDocument .PageSetup.TopMargin = 25 .PageSetup.LeftMargin = 70 '.Font.Size = 11 End With lLastRow = Cells(Rows.Count, 2).End(xlUp).Row TxtLastRow = CStr(lLastRow) Arr_in() = Range("A1:Y6" + TxtLastRow) JK = 1 lo = 0 For K = 1 To UBound(Arr_in) 'Set tbl = oDocument.Tables.Add(oDocument.Range, 16, 4) 'tbl.Borders.Enable = 1 Lo = oDocument.Paragraphs.Count oDocument.Tables.Add Range:=oDocument.Paragraphs(lo).Range, NumRows:=2, NumColumns _ :=4, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _ wdAutoFitWindow Set tbl = oDocument.Tables(K) tbl.Borders.Enable = 1 tbl.Cell(JK, 1).Merge MergeTo:=tbl.Cell(JK, 4) tbl.Cell(JK, 1).Range.Text = "ïåðâàÿ ñòðîêà è ò.ä. - " + CStr(Arr_in(K, 1)) JK = JK + 1 tbl.Cell(JK, 1).Merge MergeTo:=tbl.Cell(JK, 4) tbl.Cell(JK, 1).Range.Text = "âòîðàÿ ñòðîêà è ò.ä. - " + CStr(Arr_in(K, 2)) tbl.Cell(K + JK, 1).Select oWord.Selection.MoveDown oWord.Selection.InsertBreak JK = 1 Set tbl = Nothing Next
[/vba] Еще раз всем спасибо! SyberX
Ответить
Сообщение Проблему решил вот таким образом [vba]Код
Dim Arr_in() ' Set oWord = CreateObject("Word.Application") oWord.Visible = True Set oDocument = oWord.Documents.Add oDocument.ActiveWindow.ActivePane.View.Zoom.Percentage = 100 With oDocument .PageSetup.TopMargin = 25 .PageSetup.LeftMargin = 70 '.Font.Size = 11 End With lLastRow = Cells(Rows.Count, 2).End(xlUp).Row TxtLastRow = CStr(lLastRow) Arr_in() = Range("A1:Y6" + TxtLastRow) JK = 1 lo = 0 For K = 1 To UBound(Arr_in) 'Set tbl = oDocument.Tables.Add(oDocument.Range, 16, 4) 'tbl.Borders.Enable = 1 Lo = oDocument.Paragraphs.Count oDocument.Tables.Add Range:=oDocument.Paragraphs(lo).Range, NumRows:=2, NumColumns _ :=4, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _ wdAutoFitWindow Set tbl = oDocument.Tables(K) tbl.Borders.Enable = 1 tbl.Cell(JK, 1).Merge MergeTo:=tbl.Cell(JK, 4) tbl.Cell(JK, 1).Range.Text = "ïåðâàÿ ñòðîêà è ò.ä. - " + CStr(Arr_in(K, 1)) JK = JK + 1 tbl.Cell(JK, 1).Merge MergeTo:=tbl.Cell(JK, 4) tbl.Cell(JK, 1).Range.Text = "âòîðàÿ ñòðîêà è ò.ä. - " + CStr(Arr_in(K, 2)) tbl.Cell(K + JK, 1).Select oWord.Selection.MoveDown oWord.Selection.InsertBreak JK = 1 Set tbl = Nothing Next
[/vba] Еще раз всем спасибо! Автор - SyberX Дата добавления - 29.03.2016 в 15:50