Тема: Таблицы Word и Exel
Обсуждаем проблемы связи
Re: Таблицы Word и Exel
Для нормальной связи Таблицы Excel в Worde достаточно использовать 2-е функции
Public Function SelRng(xlRng As Excel.Range) As Excel.Range
xlRng.Select
Set SelRng = xlWBook.Application.Selection
End Function
Public Function xlTableCells(xlRng As Excel.Range) As Collection
Dim xlTableRng As Excel.Range
Dim xlSelCell As Excel.Range
Dim Cell As Collection, MergeCells As Collection
Dim rwCount As Long, clCount As Long, r As Long, c As Long
Dim NameMerge As String, i As Long, mr As Long, mc As Long
Set xlTableRng = xlRng
rwCount = xlTableRng.Rows.Count
clCount = xlTableRng.Columns.Count
Set xlTableCells = New Collection
With xlTableCells
.Add rwCount, "rwCount"
.Add clCount, "clCount"
End With
NameMerge = ""
For r = 1 To rwCount
For c = 1 To clCount
Set xlSelCell = SelRng(xlTableRng.Cells(r, c))
If InStr(1, NameMerge, xlSelCell.Address(, , xlR1C1)) = 0 Then
i = i + 1
NameMerge = NameMerge & xlSelCell.Address(, , xlR1C1)
Set Cell = New Collection
Set MergeCells = New Collection
With Cell
.Add xlSelCell, "Cell"
.Add xlSelCell.Address(, , xlR1C1)
.Add xlSelCell.Style, "Style"
.Add xlSelCell.Value, "Value"
.Add xlSelCell.Text, "Text"
.Add MergeCells, "MergeCells"
If xlSelCell.MergeCells = True Then
For mr = 1 To xlSelCell.Rows.Count
For mc = 1 To xlSelCell.Columns.Count
If mr > 1 Or mc > 1 Then
NameMerge = NameMerge & xlSelCell.Cells(mr, mc).Address(, , xlR1C1)
End If
Next mc
Next mr
mr = xlSelCell.Rows.Count - 1
mc = xlSelCell.Columns.Count - 1
With MergeCells
.Add mr, "mr"
.Add mc, "mc"
End With
c = c + mc
End If
End With
xlTableCells.Add Cell, "Cell_" & i
End If
Next c
Next r
End FunctionRe: Таблицы Word и Exel
где их (находясь в Ворде, Экселе) и как запускать?
- Alex_Gur
- Модератор
- Неактивен
Re: Таблицы Word и Exel
Обе функции должны быть на стороне Word?
Удобной и приятной работы в Word!
Перевести спасибо на Яндекс кошелёк - 41001162202962; на WebMoney - R581830807057.
Перевести спасибо на Яндекс кошелёк - 41001162202962; на WebMoney - R581830807057.
Re: Таблицы Word и Exel
Обе функции применяются на стороне Ворда.
Я создал в Ворде класс clsTableExcel вот его код
Public WithEvents xlApp As Excel.Application
Public WithEvents xlWBook As Excel.Workbook
Public WithEvents xlWSheet As Excel.Worksheet
Public Function SelRng(xlRng As Excel.Range) As Excel.Range
xlRng.Select
Set SelRng = xlWBook.Application.Selection
End Function
Public Function xlTableCells(xlRng As Excel.Range) As Collection
Dim xlTableRng As Excel.Range
Dim xlSelCell As Excel.Range
Dim Cell As Collection, MergeCells As Collection
Dim rwCount As Long, clCount As Long, r As Long, c As Long
Dim NameMerge As String, i As Long, mr As Long, mc As Long
Set xlTableRng = xlRng
rwCount = xlTableRng.Rows.Count
clCount = xlTableRng.Columns.Count
Set xlTableCells = New Collection
With xlTableCells
.Add rwCount, "rwCount"
.Add clCount, "clCount"
End With
NameMerge = ""
For r = 1 To rwCount
For c = 1 To clCount
Set xlSelCell = SelRng(xlTableRng.Cells(r, c))
If InStr(1, NameMerge, xlSelCell.Address(, , xlR1C1)) = 0 Then
i = i + 1
NameMerge = NameMerge & xlSelCell.Address(, , xlR1C1)
Set Cell = New Collection
Set MergeCells = New Collection
With Cell
.Add xlSelCell, "Cell"
.Add xlSelCell.Address(, , xlR1C1)
.Add xlSelCell.Style, "Style"
.Add xlSelCell.Value, "Value"
.Add xlSelCell.Text, "Text"
.Add MergeCells, "MergeCells"
If xlSelCell.MergeCells = True Then
For mr = 1 To xlSelCell.Rows.Count
For mc = 1 To xlSelCell.Columns.Count
If mr > 1 Or mc > 1 Then
NameMerge = NameMerge & xlSelCell.Cells(mr, mc).Address(, , xlR1C1)
End If
Next mc
Next mr
mr = xlSelCell.Rows.Count - 1
mc = xlSelCell.Columns.Count - 1
With MergeCells
.Add mr, "mr"
.Add mc, "mc"
End With
c = c + mc
End If
End With
xlTableCells.Add Cell, "Cell_" & i
End If
Next c
Next r
End FunctionЗдесь соответственно
Public WithEvents xlApp As Excel.Application
Public WithEvents xlWBook As Excel.Workbook
Public WithEvents xlWSheet As Excel.Worksheet
основные объекты экселя
Приложение
Рабочая книга
Рабочий лист
Public WithEvents дает возможность использовать события этих объектов
Вот тестирующий код
Public Sub Test()
Dim cls As clsTableExcel
Dim TableCells As Collection
Set cls = New clsTableExcel
With cls
Set .xlApp = New Excel.Application
Set .xlWBook = .xlApp.Workbooks.Add
.xlApp.Visible = True
.xlWBook.Activate
End With
Set TableCells = cls.xlTableCells(cls.xlWBook.Application.Selection)
ActiveDocument.Tables.Add Selection.Range, TableCells("rwCount"), TableCells("clCount")
cls.xlApp.Quit
End SubГде
Dim cls As clsTableExcel
Dim TableCells As Collection
cls созданный нами класс
clsTableExcelTableCells является коллекцией ячеек таблицы которые мы хотим связать
Код
With cls
Set .xlApp = New Excel.Application
Set .xlWBook = .xlApp.Workbooks.Add
.xlApp.Visible = True
.xlWBook.Activate
End Withговорит Ворду
1. Создай новое приложение Эксель
2. Создай новую рабочую книгу в этом приложении
3. Сделай данное приложение видимым
4. Сделай рабочую книгу активной
Далее идет строка
Set TableCells = cls.xlTableCells(cls.xlWBook.Application.Selection)она говорит
Присвоить переменной TableCells функцию cls.xlTableCells(cls.xlWBook.Application.Selection)
Где
cls.xlWBook.Application.Selection являются выделенными ячейками Экселя, которые мы хотим преобразовать и связать как таблицу Ворд
Далее пойдет описание действий функций
xlTableCells и SelRng
Re: Таблицы Word и Exel
Небольшое отступление…1
Ручное связывание Ворда и Экселя.
При выполнении этого действия мы должны:
1. Выделить ячейку, либо диапазон ячеек
2. Добавить их в Буфер обмена путем Копировния
3. В Ворде установить курсор в то место, где будут находиться данные Экселя
4. Далее Правка-->Специальная вставка и выбираем нужный нам параметр
Связь Экселя и Ворда произошла
Теперь рассмотрим алгоритм создания таблицы Ворд, на основе таблицы Эксель
- Alex_Gur
- Модератор
- Неактивен
Re: Таблицы Word и Exel
aap77 пишет:
Обе функции применяются на стороне Ворда.
Я создал в Ворде класс clsTableExcel вот его код
Было бы очень интересно посмотреть работу этого механизма на практике, в виде файлов.
Удобной и приятной работы в Word!
Перевести спасибо на Яндекс кошелёк - 41001162202962; на WebMoney - R581830807057.
Перевести спасибо на Яндекс кошелёк - 41001162202962; на WebMoney - R581830807057.
Re: Таблицы Word и Exel
Alex_Gur пишет:
aap77 пишет:Обе функции применяются на стороне Ворда.
Я создал в Ворде класс clsTableExcel вот его кодБыло бы очень интересно посмотреть работу этого механизма на практике, в виде файлов.
Куда уж практичней функция xlTableCells собирает все нужные данные для передачи в Ворд
Re: Таблицы Word и Exel
Вот текст функции xlTableCells с кратким описанием используемых в ней переменных:
Public Function xlTableCells(xlRng As Excel.Range) As Collection
Dim xlTableRng As Excel.Range ' Общий диапазон таблицы
Dim xlSelCell As Excel.Range ' Отдельная ячейка диапазона таблицы
Dim Cell As Collection ' Коллекция, представляющая отдельную ячеку,
' которая содержит все нужные данные и будет связана с таблицей Word
Dim MergeCells As Collection ' Коллекция входящая в коллекцию Cell и содержащая данные
' данные о количестве объединенных ячеек по горизонтали и вертикали.
' В последствии данные этой коллекции помогут корректно объединить ячейки в таблице Word
Dim rwCount As Long, clCount As Long ' Количество ячеек по горизонтали и вертикали
' в таблице Excel которую надо импортировать
Dim r As Long, c As Long ' Отдельный адрес строки и столбца в таблице Excel которую надо импортировать
Dim NameMerge As String ' Общий список уже просмотренных ячеек в таблице Excel
Dim mr As Long, mc As Long ' Данные для коллекции MergeCells
Set xlTableRng = xlRng
rwCount = xlTableRng.Rows.Count
clCount = xlTableRng.Columns.Count
Set xlTableCells = New Collection
With xlTableCells
.Add rwCount, "rwCount"
.Add clCount, "clCount"
End With
NameMerge = ""
For r = 1 To rwCount
For c = 1 To clCount
Set xlSelCell = SelRng(xlTableRng.Cells(r, c))
If InStr(1, NameMerge, xlSelCell.Address(, , xlR1C1)) = 0 Then
NameMerge = NameMerge & xlSelCell.Address(, , xlR1C1)
Set Cell = New Collection
i = i + 1
Set MergeCells = New Collection
With Cell
.Add xlSelCell, "Cell"
.Add xlSelCell.Address(, , xlR1C1)
.Add xlSelCell.Style, "Style"
.Add xlSelCell.Value, "Value"
.Add xlSelCell.Text, "Text"
.Add MergeCells, "MergeCells"
If xlSelCell.MergeCells = True Then
For mr = 1 To xlSelCell.Rows.Count
For mc = 1 To xlSelCell.Columns.Count
If mr > 1 Or mc > 1 Then
NameMerge = NameMerge & xlSelCell.Cells(mr, mc).Address(, , xlR1C1)
End If
Next mc
Next mr
mr = xlSelCell.Rows.Count - 1
mc = xlSelCell.Columns.Count - 1
With MergeCells
.Add mr, "mr"
.Add mc, "mc"
End With
c = c + mc
End If
End With
xlTableCells.Add Cell, "Cell_" & i
End If
Next c
Next r
End FunctionДалее рассмотрим подробнее действия этого кода