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

0 / 0 / 0

Регистрация: 22.11.2013

Сообщений: 108

1

14.06.2016, 11:30. Показов 11205. Ответов 5


Студворк — интернет-сервис помощи студентам

Доброго дня. появилась такая проблемка: есть электронная заявка(таблица в Excel) и есть вордовский документ который мы получаем от клиента.в вордовском документе таблица с такими же столбцами как и в электронной заявке. так вот в чем проблема, как мне привязаться из экселя к ворду? что бы можно было перенести данные из ворда в эксель. использовать ctrl+с и ctrl+v не рекомендуется, т.к. хотел бы сделать перенос через кнопку на форме. вордовский файлик всегда будет лежать в одном месте.



0



KoGG

5590 / 1580 / 406

Регистрация: 23.12.2010

Сообщений: 2,366

Записей в блоге: 1

14.06.2016, 11:56

2

Лучший ответ Сообщение было отмечено Памирыч как решение

Решение

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Sub Копирование_в_Excel_таблицу_из_Word()
    Dim i%, j%, S$, DocFullName$, WA As Object, oMyDoc As Object
    DocFullName = "C:Temp2Doc1.docx"
    Set WA = CreateObject("Word.Application")
    WA.Visible = True
    Set oMyDoc = WA.Documents.Open(DocFullName)
    For i = 1 To oMyDoc.Tables(1).Rows.Count
        For j = 1 To oMyDoc.Tables(1).Columns.Count
          S = oMyDoc.Tables(1).cell(i, j).Range.Text
          S = Replace(S, Chr(7), "") 'Удаление символа конца ячейки Word
          Cells(i, j) = S
        Next j
    Next i
    oMyDoc.Close 0
    WA.Quit False
    Set oMyDoc = Nothing: Set WA = Nothing
End Sub



1



0 / 0 / 0

Регистрация: 22.11.2013

Сообщений: 108

14.06.2016, 13:16

 [ТС]

3

очень круто) а можно что бы данные начинали вводиться с 23 строки?)



0



KoGG

5590 / 1580 / 406

Регистрация: 23.12.2010

Сообщений: 2,366

Записей в блоге: 1

14.06.2016, 13:37

4

Можно

Visual Basic
1
 Cells(i+22, j) = S



1



Ispada

0 / 0 / 0

Регистрация: 22.11.2013

Сообщений: 108

17.06.2016, 10:35

 [ТС]

5

Цитата
Сообщение от KoGG
Посмотреть сообщение

DocFullName = «C:Temp2Doc1.docx»

здесь мы указываем непосредственно путь к файл. может подскажете, как сделать, что бы мы могли выбирать этот файл сами? т.е. открывалось окно выбора файла, мы там его выбирали, ну и дальше всё как есть)

Добавлено через 45 минут
использовал

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Function GetFilePath(Optional ByVal Title As String = "Выберите файл для обработки", _
                     Optional ByVal InitialPath As String = "c:", _
                     Optional ByVal FilterDescription As String = "Файлы счетов", _
                     Optional ByVal FilterExtention As String = "*.*") As String
    On Error Resume Next
    With Application.FileDialog(msoFileDialogOpen)
        .ButtonName = "Выбрать": .Title = Title:
        .InitialFileName = GetSetting(Application.Name, "GetFilePath", "folder", InitialPath)
        .Filters.Clear: .Filters.Add FilterDescription, FilterExtention
        If .Show <> -1 Then Exit Function
        GetFilePath = .SelectedItems(1)
        folder$ = Left(.SelectedItems(1), InStrRev(.SelectedItems(1), ""))
        SaveSetting Application.Name, "GetFilePath", "folder", folder$
    End With
End Function

и вроде бы нормально работает)



0



KoGG

5590 / 1580 / 406

Регистрация: 23.12.2010

Сообщений: 2,366

Записей в блоге: 1

17.06.2016, 10:40

6

Лучший ответ Сообщение было отмечено Памирыч как решение

Решение

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = False
        .InitialFileName = "C:"
        .ButtonName = "OK"
        .Filters.Clear
        .Filters.Add Description:="Файлы Word", _
            Extensions:="*.doc*"
        If .Show = 0 Then
            Exit Sub
        End If
        DocFullName = .SelectedItems(1)
        .Filters.Clear
    End With



0



 

Dedmoroz86

Пользователь

Сообщений: 6
Регистрация: 04.10.2016

Друзья, помогите. Необходимо сделать следующее:
Смысл такой: в папке с текущим файлом Excel имеется файл Word(в формате «дизайн.rtf») его необходимо открыть и из него скопировать первые 4 таблицы. Затем вставить в ячейки Exсel и закрыть Word.
Всю голову сломал, никак не получается…. Помогите пожалуйста.  

Прикрепленные файлы

  • дизайн.rar (13.9 КБ)

 

Grr

Пользователь

Сообщений: 595
Регистрация: 17.09.2013

#2

05.10.2016 05:23:55

Одна табличка 3х3

Скрытый текст

Изменено: Grr05.10.2016 10:18:41

 

JeyCi

Пользователь

Сообщений: 3357
Регистрация: 27.11.2013

#3

05.10.2016 07:22:29

4 таблицы
файл должен лежать в одной папке с rtf-файлом

Код
Sub Copy_Word_Tables()
Dim arr As Variant
With Application: .ScreenUpdating = False: .EnableEvents = False: .DisplayAlerts = False: .Calculation = xlManual: End With

'открытие Word-файла
    Set oWord = CreateObject("Word.Application")
    oWord.Visible = True
    Set oDoc = oWord.Documents.Open(ThisWorkbook.Path & "" & "дизайн.rtf")
    
ThisWorkbook.Sheets(1).UsedRange.ClearContents
rr = 1

'On Error Resume Next
For aTbl = 1 To 4   'oDoc.tables.Count
ReDim arr(1 To oDoc.tables(aTbl).Rows.Count, 1 To oDoc.tables(aTbl).Columns.Count)
    For j = 1 To UBound(arr, 2)
        For i = 1 To UBound(arr, 1)
            arr(i, j) = Trim(Replace(oDoc.tables(aTbl).cell(i, j).Range.Text, Chr(7), ""))
        Next i
    Next j
ThisWorkbook.Sheets(1).Range("A" & rr).Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
rr = rr + oDoc.tables(aTbl).Rows.Count + 2
arr = Empty
Next

oWord.Quit False
'..................
With Application: .ScreenUpdating = True: .EnableEvents = True: .DisplayAlerts = True: .Calculation = xlAutomatic: End With
MsgBox "Tables loaded"
End Sub

Прикрепленные файлы

  • Copy_Word_Tables.xlsm (19.52 КБ)

Изменено: JeyCi05.10.2016 07:34:45

чтобы не гадать на кофейной гуще, кто вам отвечает и после этого не совершать кучу ошибок — обратитесь к собеседнику на ВЫ — ответ на ваш вопрос получите — а остальное вас не касается (п.п.п. на форумах)

 

Grr

Пользователь

Сообщений: 595
Регистрация: 17.09.2013

JeyCi, никакого пространства для самодеятельности не оставили :)

 

JeyCi

Пользователь

Сообщений: 3357
Регистрация: 27.11.2013

#5

05.10.2016 07:34:29

Цитата
Grr написал: никакого пространства для самодеятельности

названия таблиц из word’а выковыривать не буду  :) — оставляю для самодеятельности  

чтобы не гадать на кофейной гуще, кто вам отвечает и после этого не совершать кучу ошибок — обратитесь к собеседнику на ВЫ — ответ на ваш вопрос получите — а остальное вас не касается (п.п.п. на форумах)

 

Dedmoroz86

Пользователь

Сообщений: 6
Регистрация: 04.10.2016

Огромное спасибо!!!! Помогло! =))))))  

 

Dedmoroz86

Пользователь

Сообщений: 6
Регистрация: 04.10.2016

Один вопрос остался, все цифры не поддаются математическим расчетам, в связи с тем что в конце каждой имеется пробел. Может существует макрос чтобы его убрать? Количество строк динамическое(т.е может быть меньше может быть больше).  

 

Grr

Пользователь

Сообщений: 595
Регистрация: 17.09.2013

Стандартный функционал — «Найти/Заменить»?

 

JeyCi

Пользователь

Сообщений: 3357
Регистрация: 27.11.2013

#9

05.10.2016 12:34:13

после 18-й строки (перед Next i) — можете вставить проверку

Код
If IsNumeric(arr(i, j)) Then arr(i, j) = --arr(i, j)

чтобы не гадать на кофейной гуще, кто вам отвечает и после этого не совершать кучу ошибок — обратитесь к собеседнику на ВЫ — ответ на ваш вопрос получите — а остальное вас не касается (п.п.п. на форумах)

 

Alex_24

Пользователь

Сообщений: 9
Регистрация: 22.01.2018

#10

03.03.2018 16:30:49

Все похоже сделал правильно, а Excel ругается 5941 ошибкой. Что не так подскажите?

Код
Sub Copy_Word_Tables()
Dim arr As Variant
Dim fileToOpen
With Application: .ScreenUpdating = False: .EnableEvents = False: .DisplayAlerts = False: Calculation = xManual: End With
Set oWord = CreateObject("Word.Application")
oWord.Visible = True
fileToOpen = Application.GetOpenFilename("Only these Files (*.txt;*.doc*;*.xls*), *.txt; *.doc*; *.xls*")
Set oDoc = oWord.Documents.Open(fileToOpen)
ThisWorkbook.Sheets("Вводный").UsedRange.ClearContents
rr = 1
ReDim arr(1 To oDoc.tables(1).Rows.Count, 1 To oDoc.tables(1).Columns.Count)
For j = 1 To UBound(arr, 2)
    For i = 1 To UBound(arr, 1)
    arr(i, j) = Trim(Replace(oDoc.tables(1).cell(i, j).Range.Text, Chr(7), ""))
    Next i
Next j
ThisWorkbook.Sheets("Вводный").Range("A" & rr).Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
rr = rr + oDoc.tables(1).RowCount + 2
oWord.Ouit False
With Application: .ScreenUpdating = True: .EnableEvents = True: .DisplayAlerts = True: Calculation = xManual: End With
End Sub
 

Юрий М

Модератор

Сообщений: 60588
Регистрация: 14.09.2012

Контакты см. в профиле

Alex_24, Вы видели, как форумчане оформляют свой код? Вот и Вы оформляйте аналогично: для этого есть специальная кнопка <…>

 

Alex_24, Вы код вручную набивали, что ли? Бросилось в глаза:
— 4 строка .Calculation = xlManual
— 3 c конца строка oWord.Quit False

Есть еще ошибки, но до устранения замечания не скажу где.

Изменено: Казанский03.03.2018 21:39:38

 

nuroraf

Пользователь

Сообщений: 1
Регистрация: 03.05.2019

JeyCi,

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

  • ·           One

  • ·         Two

  • ·         Three

  • ·         Four

Можно ли скопировать такое точь в точь в ячейку на экзеле?

 

sokol92

Пользователь

Сообщений: 4446
Регистрация: 10.09.2017

#14

03.05.2019 21:09:47

Добавьте после строки 18 в #3:

Код
            While Right(arr(i, j), 1) = Chr(10) Or Right(arr(i, j), 1) = Chr(13)
              arr(i, j) = Left(arr(i, j), Len(arr(i, j)) - 1)
            Wend
            arr(i, j) = Replace(arr(i, j), Chr(13), Chr(10))

Владимир

 

Игорь

Пользователь

Сообщений: 2
Регистрация: 28.03.2023

[CODE][/CODE]

Изменено: Игорь29.03.2023 15:27:31

 

Игорь

Пользователь

Сообщений: 2
Регистрация: 28.03.2023

#16

29.03.2023 13:14:58

Код
"спасибо" за помощь. Модераторы удалите мои сообщения.

Изменено: Игорь29.03.2023 15:31:11

Skip to content

Как из Word перевести в Excel

На чтение 4 мин. Просмотров 7k.

Что делает макрос: Если вы обнаружите, что вы постоянно копируете данные и вставляете в Microsoft Word, вы можете использовать макрос, чтобы автоматизировать эту задачу.

Содержание

  1. Как макрос работает
  2. Код макроса
  3. Как этот код работает
  4. Как использовать

Как макрос работает

Перед тем как использовать макрос, очень важно к этому подготовиться. Чтобы подготовиться к процессу, вы должны иметь созданный шаблон Word . В этом документе, указать закладку, где вы хотите, чтобы ваши данные из Excel разместились.
Чтобы создать закладку в документе Word, поместите курсор в нужное место, выберите вкладку Вставка — Закладка. Это активизирует диалоговое окно Закладка, где вы назначаете имя
для закладки. После того, как назначено имя, нажмите кнопку Добавить.

Один из файлов образцов для этой части является документ под названием PasteTable.docx. Это документ представляет собой простой шаблон, который содержит одну закладку под названием DataTableHere. В этом примере кода вы скопируете диапазон к этому
шаблону PasteTable.docx, используя закладку DataTableHere, чтобы указать, где вставить скопированный диапазон.
Кроме того, необходимо установить ссылку на библиотеку объектов Microsoft Word.

Код макроса

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

Как этот код работает

  1. Шаг 1 объявляет четыре переменные: MyRange содержит целевой диапазон Excel; WD является переменной, которая предоставляет объект Application Word; wdDoc является переменной объекта, которая выставляет объект Word Document; wdRange является переменной объекта, которая выставляет объект Range Word.
  2. Шаг 2 копирует диапазон таблицы рабочего листа. В этом примере, диапазон жёсткий, но мы всегда можем сделать этот выбор в нечто более переменное.
  3. Шаг 3 открывает существующий целевой документ Word, который служит в качестве шаблона. Обратите внимание, что мы устанавливаем свойство Visible приложения Word, в True.
    Это гарантирует, что мы можем увидеть действие в Word, как работает код.
  4. Шаг 4 использует объект Range в Word, чтобы установить фокус на целевой закладке. Это по существу выбирает закладку в виде диапазона, что позволяет принимать меры в этом диапазоне.
  5. Шаг 5 удаляет любую таблицу, которая может существовать внутри закладки, а затем вставляет скопированный диапазон Excel. Если мы не будем удалять любые существующие таблицы, скопированный диапазон добавится к существующим данным.
  6. Когда вы копируете диапазон Excel в документ Word, ширина столбцов не всегда соответствуют содержанию в клетках. Шаг 6 устраняет эту проблему путем регулировки ширины столбцов. Здесь, ширина каждого столбца установлена как число, которое равно общей ширине таблицы, разделенной на число столбцов в таблице.
  7. Когда мы копируем диапазон Excel для целевой закладки, мы, по существу, перезаписываем закладку. Шаг 7 воссоздает закладку, чтобы гарантировать, что в следующий раз, когда вы запустите этот код, закладка будет.
  8. Очистка памяти

Как использовать

Для реализации этого макроса, вы можете скопировать и вставить его в стандартный модуль:

  1. Активируйте редактор Visual Basic, нажав ALT + F11.
  2. Щелкните правой кнопкой мыши имя проекта / рабочей книги в окне проекта.
  3. Выберите Insert➜Module.
  4. Введите или вставьте код.

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 )

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

[свернуть]

Понравилась статья? Поделить с друзьями:
  • Таблиц excel по реализации товара
  • Таблиц excel для чемпионата
  • Таблиц excel для мебели
  • Таблиц excel в xml
  • Таблетки от суставов для собаки excel