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

Вход

Регистрация

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

 

= Мир MS Excel/Циклическое создание таблиц в Word из Excel - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Циклическое создание таблиц в Word из Excel (Макросы/Sub)
Циклическое создание таблиц в 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. не срабатывают. без них тоже. подскажите как быть?
К сообщению приложен файл: 6711362.xls (39.0 Kb)


Сообщение отредактировал 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](Контрл Енд и вставка разрыва страницы)


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
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:=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
Дата добавления - 29.03.2016 в 14:30
_Boroda_ Дата: Вторник, 29.03.2016, 14:30 | Сообщение № 5
Группа: Модераторы
Ранг: Местный житель
Сообщений: 16666
Репутация: 6478 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
Ну ясен пень, я же дал Вам код Ворда, а Вы его из Excel запускаете.
У Вас объект Ворда oWord, вот туда все это и суйте.


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
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
Дата добавления - 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
Дата добавления - 29.03.2016 в 15:50
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Циклическое создание таблиц в Word из Excel (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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