Таблиц word в excel макросом

Skip to content

Sub OtpravitDannieIzExcelVWord()
'Шаг 1: Объявляем переменные
Dim MyRange As Excel.Range
Dim wd As Word.Application
Dim wdDoc As Word.Document
Dim WdRange As Word.Range

'Шаг 2: Скопируйте определенный диапазон
Sheets("таблица доходов").Range("B4:F10").Copy

'Шаг 3: Откройте целевой документ Word
Set wd = New Word.Application
Set wdDoc = wd.Documents.Open _
(ThisWorkbook.Path & "" & "PasteTable.docx")
wd.Visible = True

'Шаг 4: Установить фокус на целевую закладку
Set WdRange = wdDoc.Bookmarks("DataTableHere").Range

'Шаг 5: Удалить старую таблицу и вставить новую
On Error Resume Next
WdRange.Tables(1).Delete
WdRange.Paste 'вставить в таблицу

'Шаг 6: Отрегулируйте ширину столбца
WdRange.Tables(1).Columns.SetWidth _
(MyRange.Width / MyRange.Columns.Count), wdAdjustSameWidth

'Шаг 7: Вставьте закладку
wdDoc.Bookmarks.Add "DataTableHere", WdRange

'Шаг 8: Очистка памяти
Set wd = Nothing
Set wdDoc = Nothing
Set WdRange = Nothing

End Sub

Sub Procedure_1()

        ‘В константе «strDocFullName» нужно указать полное имя Word-документа,
        ‘из которого нужно скопировать таблицу.
    Const strDocFullName As String = «C:UsersUserDesktopИз.docx»

        ‘Для написания макроса, удобно подключить библиотеку для работы
        ‘с программой «Word». Затем можно будет отключить эту библиотеку:
    ‘Tools — References… — Microsoft Word версия Object Library.
    Dim myWord As Word.Application
    Dim docSource As Word.Document

            ‘Запуск и VBA-наименование программы «Word».
        ‘Даём программе «Word» VBA-имя «myWord» и через
        ‘это имя будем работать с программой Word в макросе.
    Set myWord = CreateObject(Class:=»Word.Application»)

        ‘Делаем программу Word видимой, чтобы было удобно писать код.
    myWord.Visible = True

        ‘Открытие и VBA-наименование Word-файла.
    Set docSource = myWord.Documents.Open(Filename:=strDocFullName)

        ‘Копирование первой таблицы в Word-файле.
    ‘Range — это фрагмент Word-файла, где находится таблица.
    docSource.Tables(1).Range.Copy

        ‘Выделение ячейки, куда будут вставлены данные.
        ‘Для вставки в Excel будет использоваться метод «PasteSpecial»,
        ‘который относится к объекту «Worksheet». Метод «PasteSpectial»
        ‘ещё есть у объекта «Range». У объекта «Worksheet» нельзя
        ‘указать ячейку, куда надо вставить, поэтому нужно заранее
        ‘выделить нужную ячейку, куда будут вставлены данные.
    ActiveSheet.Range(«A1»).Select

        ‘Вставка скопированной таблицы в активный Excel-лист в выделенную ячейку.
    ‘Код записал с помощью макрорекордера, делая такие действия в «Excel 2010»:
        ‘вкладка «Главная» — группа «Буфер обмена» — «Вставить (со стрелкой)» —
        ‘»Специальная вставка…» — кружок «Вставить» — «HTML».
    ActiveSheet.PasteSpecial Format:=»HTML», Link:=False

        ‘Чтобы в буфере обмена не было много данных, очищаем буфер обмена,
        ‘копируя в него только одну ячейку.
    docSource.Tables(1).Cell(1, 1).Range.Copy

        ‘Закрытие Word-документа.
    ‘0 — без сохранения.
    docSource.Close SaveChanges:=0

        ‘Закрытие программы «Word».
    myWord.Quit SaveChanges:=0

    End Sub

[свернуть]

Answer taken from: http://www.mrexcel.com/forum/showthread.php?t=36875

Here is some code that reads a table from Word into the active worksheet of Excel. It prompts you for the word document as well as the table number if Word contains more than one table.

Sub ImportWordTable()
Dim wdDoc As Object
Dim wdFileName As Variant
Dim TableNo As Integer 'table number in Word
Dim iRow As Long 'row index in Excel
Dim iCol As Integer 'column index in Excel

wdFileName = Application.GetOpenFilename("Word files (*.doc),*.doc", , _
"Browse for file containing table to be imported")

If wdFileName = False Then Exit Sub '(user cancelled import file browser)

Set wdDoc = GetObject(wdFileName) 'open Word file

With wdDoc
    TableNo = wdDoc.tables.Count
    If TableNo = 0 Then
        MsgBox "This document contains no tables", _
        vbExclamation, "Import Word Table"
    ElseIf TableNo > 1 Then
        TableNo = InputBox("This Word document contains " & TableNo & " tables." & vbCrLf & _
        "Enter table number of table to import", "Import Word Table", "1")
    End If
    With .tables(TableNo)
        'copy cell contents from Word table cells to Excel cells
        For iRow = 1 To .Rows.Count
            For iCol = 1 To .Columns.Count
                Cells(iRow, iCol) = WorksheetFunction.Clean(.cell(iRow, iCol).Range.Text)
            Next iCol
        Next iRow
    End With
End With

Set wdDoc = Nothing

End Sub

This macro should be inserted into Excel (not Word) and put into a standard macro module rather than into the worksheet or workbook event code modules. To do this, go to the VBA (keyboard Alt-TMV), insert a macro module (Alt-IM), and paste the code into the code pane. Run the macro from the Excel interface as you would any other (Alt-TMM).

If your document contains many tables, as would be the case if your 100+ page table is actually a separate table on each page, this code could easily be modified to read all the tables. But for now I am hoping it is all one continuous table and will not require any modification.

Keep Excelling.

Damon

VBAexpert Excel Consulting
(My other life: http://damonostrander.com )