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

Вход

Регистрация

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

 

= Мир MS Excel/Вставка таблицы из Excel в шаблон Word - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, Manyasha, SLAVICK, китин  
Мир MS Excel » Вопросы и решения » Excel и другие приложения » Word » Вставка таблицы из Excel в шаблон Word (Проблемма с форматированием)
Вставка таблицы из Excel в шаблон Word
Benos Дата: Четверг, 12.11.2020, 22:22 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 19
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016 / 365
Добрый день!
Есть Реестр, по нему надо формировать отчет.
Принцип следующий:
1. Данные в Excel заносятся в отдельный лист (в определенную форму)
2. Далее в шаблон Word идет вставка таблицы с листа по п.1 через закладку.

Все работает, но при вставке нарушается форматирование (таблица не влезает, между строк появляются пустые строки, слетает шрифт).
Подскажите как можно это исправить?
И второй вопрос, как закрепить шапку таблицы, что бы она дублировалась на новых страницах (это возможно из Excel)?

Эту тему видел, но вставка через PasteSpecial не совсем мне подходит.

Вот код
[vba]
Код
Sub crReport()
    Dim reportDate As String
    Dim iCell As Range
    Dim iRow As Integer
    Dim iText As String
    Dim iStNum As Integer
    Dim jText As String
    Dim jStNum As Integer
    Dim iDate As String
    Dim LValue As String
    Dim arrStatTXT As Variant
    arrStatTXT = Array("J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T")
    
    iDate = Date
    Worksheets("Отчет").Cells(3, "D").Value = iDate & " г."
    
    For Each iCell In Range(Worksheets("Заявки").Cells(3, 2), Worksheets("Заявки").Cells(Rows.Count, 2).End(xlUp))
        iRow = iCell.Row + 3
        Worksheets("Отчет").Cells(iRow, 1).Value = Worksheets("Заявки").Cells(iCell.Row, 1).Value
        Worksheets("Отчет").Cells(iRow, "B").Value = "АААА/" & Worksheets("Заявки").Cells(iCell.Row, "H").Value & vbNewLine & "от " & _
                    Worksheets("Заявки").Cells(iCell.Row, "I").Value & " г."
        Worksheets("Отчет").Cells(iRow, "C").Value = Worksheets("Заявки").Cells(iCell.Row, "B").Value
        Worksheets("Отчет").Cells(iRow, "D").Value = Worksheets("Заявки").Cells(iCell.Row, "E").Value & vbNewLine & _
                    Worksheets("Заявки").Cells(iCell.Row, "G").Value & vbNewLine & "по " & _
                    Worksheets("Заявки").Cells(iCell.Row, "F").Value & vbNewLine
        Worksheets("Отчет").Cells(iRow, "G").Value = Worksheets("Заявки").Cells(iCell.Row, "T").Value
        iText = ""
        iStNum = 0
        For iTXT = LBound(arrStatTXT) To UBound(arrStatTXT)
            If Worksheets("Заявки").Cells(iCell.Row, arrStatTXT(iTXT)).Interior.ColorIndex <> xlNone Then
                iStNum = iStNum + 1
                iText = iText & iStNum & ". " & Worksheets("Заявки").Cells(iCell.Row, arrStatTXT(iTXT)).Value & vbNewLine
            End If
        Next iTXT
        Worksheets("Отчет").Cells(iRow, "E").Value = iText
        jText = ""
        jStNum = 0
        For jTXT = LBound(arrStatTXT) To UBound(arrStatTXT)
            If Worksheets("Заявки").Cells(iCell.Row, arrStatTXT(jTXT)).Font.Color <> 0 Then
                jStNum = jStNum + 1
                jText = jText & jStNum & ". " & Worksheets("Заявки").Cells(iCell.Row, arrStatTXT(jTXT)).Value & vbNewLine
            End If
        Next jTXT
        Worksheets("Отчет").Cells(iRow, "F").Value = jText
    Next
    Call CreateWord
End Sub
Sub CreateWord()
    Debug.Print "Создаем Word!"
    Dim fData As String
    Dim objWord As Object
    Dim wPath As String
    
    fData = Format(Date, "yyyy/mm/dd")
    
    Set wa = CreateObject("Word.Application")
    wa.Visible = True
    wPath = ActiveWorkbook.Path & "\Форма_отчета.dotx"
    Set objWord = wa.Documents.Add(wPath)

    Range(Worksheets("Отчет").Cells(5, 1), Worksheets("Отчет").Cells(Rows.Count, "G").End(xlUp)).Copy
    objWord.Bookmarks("Дата_Отчета").Range.Text = Worksheets("Отчет").Cells(3, "D").Value
    objWord.Bookmarks("Таблица_Отчета").Range.Paste
    'With .Tables(1)
    '       .Rows.HeightRule = 2 'wdRowHeightExactly
    '        For i = 1 To Selection.Cells.Count
    '            .Rows(i).Height = Rows(i).Height
    '            .Range.Font.Name = "Times New Roman"
    '        Next
    ' End With
    objWord.SaveAs FileName:=ActiveWorkbook.Path & "\" & fData & "__Отчет.docx"
    
    objWord.Close True
    wa.Quit
    Set wa = Nothing
        
End Sub
[/vba]

Пример в приложении.

Буду благодарен за помощь!
К сообщению приложен файл: 1675291.xlsm(40.0 Kb) · 7811310.dotx(16.9 Kb)
 
Ответить
СообщениеДобрый день!
Есть Реестр, по нему надо формировать отчет.
Принцип следующий:
1. Данные в Excel заносятся в отдельный лист (в определенную форму)
2. Далее в шаблон Word идет вставка таблицы с листа по п.1 через закладку.

Все работает, но при вставке нарушается форматирование (таблица не влезает, между строк появляются пустые строки, слетает шрифт).
Подскажите как можно это исправить?
И второй вопрос, как закрепить шапку таблицы, что бы она дублировалась на новых страницах (это возможно из Excel)?

Эту тему видел, но вставка через PasteSpecial не совсем мне подходит.

Вот код
[vba]
Код
Sub crReport()
    Dim reportDate As String
    Dim iCell As Range
    Dim iRow As Integer
    Dim iText As String
    Dim iStNum As Integer
    Dim jText As String
    Dim jStNum As Integer
    Dim iDate As String
    Dim LValue As String
    Dim arrStatTXT As Variant
    arrStatTXT = Array("J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T")
    
    iDate = Date
    Worksheets("Отчет").Cells(3, "D").Value = iDate & " г."
    
    For Each iCell In Range(Worksheets("Заявки").Cells(3, 2), Worksheets("Заявки").Cells(Rows.Count, 2).End(xlUp))
        iRow = iCell.Row + 3
        Worksheets("Отчет").Cells(iRow, 1).Value = Worksheets("Заявки").Cells(iCell.Row, 1).Value
        Worksheets("Отчет").Cells(iRow, "B").Value = "АААА/" & Worksheets("Заявки").Cells(iCell.Row, "H").Value & vbNewLine & "от " & _
                    Worksheets("Заявки").Cells(iCell.Row, "I").Value & " г."
        Worksheets("Отчет").Cells(iRow, "C").Value = Worksheets("Заявки").Cells(iCell.Row, "B").Value
        Worksheets("Отчет").Cells(iRow, "D").Value = Worksheets("Заявки").Cells(iCell.Row, "E").Value & vbNewLine & _
                    Worksheets("Заявки").Cells(iCell.Row, "G").Value & vbNewLine & "по " & _
                    Worksheets("Заявки").Cells(iCell.Row, "F").Value & vbNewLine
        Worksheets("Отчет").Cells(iRow, "G").Value = Worksheets("Заявки").Cells(iCell.Row, "T").Value
        iText = ""
        iStNum = 0
        For iTXT = LBound(arrStatTXT) To UBound(arrStatTXT)
            If Worksheets("Заявки").Cells(iCell.Row, arrStatTXT(iTXT)).Interior.ColorIndex <> xlNone Then
                iStNum = iStNum + 1
                iText = iText & iStNum & ". " & Worksheets("Заявки").Cells(iCell.Row, arrStatTXT(iTXT)).Value & vbNewLine
            End If
        Next iTXT
        Worksheets("Отчет").Cells(iRow, "E").Value = iText
        jText = ""
        jStNum = 0
        For jTXT = LBound(arrStatTXT) To UBound(arrStatTXT)
            If Worksheets("Заявки").Cells(iCell.Row, arrStatTXT(jTXT)).Font.Color <> 0 Then
                jStNum = jStNum + 1
                jText = jText & jStNum & ". " & Worksheets("Заявки").Cells(iCell.Row, arrStatTXT(jTXT)).Value & vbNewLine
            End If
        Next jTXT
        Worksheets("Отчет").Cells(iRow, "F").Value = jText
    Next
    Call CreateWord
End Sub
Sub CreateWord()
    Debug.Print "Создаем Word!"
    Dim fData As String
    Dim objWord As Object
    Dim wPath As String
    
    fData = Format(Date, "yyyy/mm/dd")
    
    Set wa = CreateObject("Word.Application")
    wa.Visible = True
    wPath = ActiveWorkbook.Path & "\Форма_отчета.dotx"
    Set objWord = wa.Documents.Add(wPath)

    Range(Worksheets("Отчет").Cells(5, 1), Worksheets("Отчет").Cells(Rows.Count, "G").End(xlUp)).Copy
    objWord.Bookmarks("Дата_Отчета").Range.Text = Worksheets("Отчет").Cells(3, "D").Value
    objWord.Bookmarks("Таблица_Отчета").Range.Paste
    'With .Tables(1)
    '       .Rows.HeightRule = 2 'wdRowHeightExactly
    '        For i = 1 To Selection.Cells.Count
    '            .Rows(i).Height = Rows(i).Height
    '            .Range.Font.Name = "Times New Roman"
    '        Next
    ' End With
    objWord.SaveAs FileName:=ActiveWorkbook.Path & "\" & fData & "__Отчет.docx"
    
    objWord.Close True
    wa.Quit
    Set wa = Nothing
        
End Sub
[/vba]

Пример в приложении.

Буду благодарен за помощь!

Автор - Benos
Дата добавления - 12.11.2020 в 22:22
Мир MS Excel » Вопросы и решения » Excel и другие приложения » Word » Вставка таблицы из Excel в шаблон Word (Проблемма с форматированием)
  • Страница 1 из 1
  • 1
Поиск:

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