Копирование таблиц vba word

Sub ExcelRangeToWord()

‘PURPOSE: Copy/Paste An Excel Table Into a New Word Document
‘NOTE: Must have Word Object Library Active in Order to Run _
  (VBE > Tools > References > Microsoft Word 12.0 Object Library)
‘SOURCE: www.TheSpreadsheetGuru.com

Dim tbl As Excel.Range
Dim WordApp As Word.Application
Dim myDoc As Word.Document
Dim WordTable As Word.Table

‘Optimize Code
  Application.ScreenUpdating = False
  Application.EnableEvents = False

‘Copy Range from Excel
  Set tbl = ThisWorkbook.Worksheets(Sheet1.Name).ListObjects(«Table1»).Range

‘Create an Instance of MS Word
  On Error Resume Next

        ‘Is MS Word already opened?
      Set WordApp = GetObject(class:=»Word.Application»)

        ‘Clear the error between errors
      Err.Clear

    ‘If MS Word is not already open then open MS Word
      If WordApp Is Nothing Then Set WordApp = CreateObject(class:=»Word.Application»)

        ‘Handle if the Word Application is not found
      If Err.Number = 429 Then
        MsgBox «Microsoft Word could not be found, aborting.»
        GoTo EndRoutine
      End If

  On Error GoTo 0

  ‘Make MS Word Visible and Active
  WordApp.Visible = True
  WordApp.Activate

    ‘Create a New Document
  Set myDoc = WordApp.Documents.Add

  ‘Copy Excel Table Range
  tbl.Copy

‘Paste Table into MS Word
  myDoc.Paragraphs(1).Range.PasteExcelTable _
    LinkedToExcel:=False, _
    WordFormatting:=False, _
    RTF:=False

‘Autofit Table so it fits inside Word Document
  Set WordTable = myDoc.Tables(1)
  WordTable.AutoFitBehavior (wdAutoFitWindow)

   EndRoutine:
‘Optimize Code
  Application.ScreenUpdating = True
  Application.EnableEvents = True

‘Clear The Clipboard
  Application.CutCopyMode = False

End Sub

In this part of the code we are determining if Microsoft Word is open or not.  If Word is already open, we can set a variable equal to the entire program by using GetObject.  If MS Word is not currently running we can use CreateObject to run an instance of Word and then set a variable equal to that specific instance of MS Word.

When using CreateObject, the target application will start running but it is not visible on screen.  Therefore we need to turn the Visible setting on (equal to true).  Also, VBA with Word is a little bit different than with Excel in that it is much more dependent on its window showing on screen.  Therefore a second command must be written to Activate Microsoft Word.

Copy From Excel, Paste Onto Document

Now that you have a new document created, you can command Excel to paste your table into MS Word.  Near the beginning of the code, there was a line that allowed you to specify the exact table you wanted to copy.  The variable tbl was used to remember this table range and to allow you to reference the range later on in the code.  

Guru Tip: It is a good idea to place code that may need to be manually changed at some point in the future near the beginning of the subroutine.  This prevents you from having to scroll through your code and pinpoint the exact place where you spelled out which range you wanted to copy or which worksheet you wanted to pull data from.  This can save you a bunch of time and prevent confusion!

Word has a special method called PasteExcelTable, which (as you can guess) allows you paste in an Excel table.  There are three variables you can tweak to get you table looking and functioning just the way you want.

• LinkedToExcel — True links the pasted table to the original Excel file so that changes made to the Excel file are reflected in Microsoft Word.

• WordFormatting — True formats the table using the formatting in the Word document.  False formats the table according to the original Excel file.

• RTF — True pastes the Excel table using Rich Text Format (RTF).  False pastes the Excel table as HTML.

Now for the last step!  Depending on how large your table is, it may be spilling outside of your document page.  In order to prevent this from happening you can go ahead and use AutoFitBehavior to resize the table to fit perfectly inside your Word document.

About The Author

Hey there! I’m Chris and I run TheSpreadsheetGuru website in my spare time. By day, I’m actually a finance professional who relies on Microsoft Excel quite heavily in the corporate world. I love taking the things I learn in the “real world” and sharing them with everyone here on this site so that you too can become a spreadsheet guru at your company.

Through my years in the corporate world, I’ve been able to pick up on opportunities to make working with Excel better and have built a variety of Excel add-ins, from inserting tickmark symbols to automating copy/pasting from Excel to PowerPoint. If you’d like to keep up to date with the latest Excel news and directly get emailed the most meaningful Excel tips I’ve learned over the years, you can sign up for my free newsletters. I hope I was able to provide you with some value today and I hope to see you back here soon!

— Chris
Founder, TheSpreadsheetGuru.com

Sub макрос()

        Dim docSrc As Document, docRes As Document, rngTable As Range
    Dim strFN As String

        ‘1. Отключение монитора. Может это уменьшит мерцание и может ускорит макрос.
    Application.ScreenUpdating = False

    ‘2. Юзер выбирает файл, в котором таблица.
    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = False
        .Filters.Clear
        .Filters.Add «Документы Word», «*.docx»
        If .Show = 0 Then
            Exit Sub
        End If
        strFN = .SelectedItems(1)
    End With

        ‘3. Присваивание имени «docRes» активного файлу (в который надо вставить таблицу).
        ‘ После открытия другого файла, он станет неактивным.
    Set docRes = ActiveDocument

        ‘4. Открытие файла, в котором таблица. При этом присваиваем файлу имя «docSrc».
    Set docSrc = Documents.Open(FileName:=strFN)

        ‘5. Копирование таблицы из одного файла в другой.
    With docRes.Range.find
        ‘ Текст-метка, куда надо вставить таблицу.
        .Text = «~таблица~»
        ‘ Поиск текста-метки.
        .Execute
        ‘ Присваиваем имя «rngTable» фрагменту, в котором находится текст-метка.
            ‘ Parent — это найденный текст.
        Set rngTable = .Parent
    End With

        ‘6. Убираем цветовую заливку.
    rngTable.HighlightColorIndex = wdNoHighlight

        ‘7. Вставка таблицы. Копируется первая таблица из файла-источника.
    docSrc.Tables(1).Range.Copy
    rngTable.Paste

        ‘8. Очистка буфера обмена. Если таблица большая, то при закрытии ворда
        ‘ будет сообщение, что в буфере много данных.
        ‘ Просто копируем первый символ.
    docSrc.Range.Characters(1).Copy

        ‘9. Закрытие файла-источника.
    docSrc.Close SaveChanges:=False

        ’10. Включение монитора.
    Application.ScreenUpdating = True

    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 )

ДОбрый день, уважаемые специалисты и гости форума.

Вопрос по VBA Word 2003.

Задача: в одном файле есть таблица, ее нужно перенести в другой файл без изменений, причем там, чтобы таблица была отобрана из всех таблиц в документе по совпадению строки. Получился следующий код:

Sub KopirovanieDatiVEtotGeFail()
Dim strFIOTable As Range
strFIOTable = MatchedTable("фамилия")
Documents.Add Template:="c:UserslordDesktopTemplate.dot"
 End Sub
Function MatchedTable(strMatch As String)
For Each aTable In ActiveDocument.Tables
aTable.Select
Set tmpTable = Selection.Range
Dim tableMatch As New RegExp
tableMatch.Global = False
tableMatch.Multiline = True
tableMatch.IgnoreCase = True
tableMatch.Pattern = strMatch '<--это "фаимлия"
If tableMatch.Test(tmpTable) Then
Dim rMatchedTable As Range
Set rMatchedTable = tmpTable 'здесь нужна помощь
'strTable = tmpTable 
'strTable.Select
rMatchedTable.Select
End If
Next aTable
MatchedTable = rMatchedTable 'здесь нужна помощь
End Function

Проблема возникла с возвратом объекта «Таблица» из функции — не могу присвоить его в переменную и вставить в новый документ в нужную закладку. Если я делаю strTable (As String) = tmpTable, то вся таблица превращается в строку и в новый файл вставляется в виде
текста без разделителей. Если помечаю Function MatchedText(strMatch As String) As Range (чтобы из функции получить таблицу в качестве Range), то в самом конце функции я не могу присвоить  MatchedTable = rMatchedTable (ругается на отсутсвие with, а я не
могу понять, где его вставить). Задача сводится к тому, чтобы на выходе функции получить таблицу в виде таблицы, а не строки, и перенести ее в новый файл без изменений. На выбор у меня (из моего понимания мануала) есть несколько вариантов:

— копать в сторону range…copy, range…paste

— копать в сторону метода ConvertToTable

Прошу Вашей помощи. Буду благодарен за любые советы.

Пробовал искать информацию самостоятельно: везде пишут только про вставку информации из таблицы, вставку информации из таблицы word в excel или наоборот, но вот как просто скопировать таблицу из word целиком — не могу понять. Заранее всем спасибо