Конвертирование таблиц Word в Excel средствами VBA

[AsDev]

Столкнулся с проблемой.Необходимо из Word скопировать кучу таблиц в Excel со сложной структурой.Может кто сталкивался в подобной проблемой и знает хотя бы частичный способ конвертирования средствами VBA?

[Димитрий]

Такой макрос может помочь:

Код: Выделить всё

Dim objXl As Object, tb As Table
  Set objXl = CreateObject("Excel.Application")
  objXl.Workbooks.Add
  objXl .Visible = True
For Each tb In Documents(1).Tables
    tb.Select
    Selection.Copy
    objXl.ActiveSheet.Paste
    objXl.Workbooks(1).Worksheets.Add.Activate
Next

[Al Khamid]

[AsDev]

Вот и я так думаю,а может есть более изящный способ?

[$€rg]

лучше вроде ничего не нашел
http://bbs.vbstreets.ru/viewtopic.php?t ... word+cells

[Димитрий]

Al Khamid
Пришли сложную таблицу и пожелания, попробую сохранить полную структуру.

[AsDev]

Дело в том что одной таблицой, здесь не обойтись необходимо автоматизированно конвертировать десятки таблиц и привести их к виду-из сложной таблицы сделать несколько простых-каждый показатель в отдельной таблице.

[Димитрий]

AsDev
Мне нужен пример для образца (чего я поковырял бы )

[nopik]

У меня проблема аналогичная - надо за- и изгонять данные в таблицах Word.
Единственно работающее решение для таблиц "нарисованных" от руки (Word нумерует ячейки таблицы в процессе добавления, и черта, нарисованная оператором через ячейку изменит ПОРЯДКОВЫЕ НОМЕРА ячеек в массиве):
Selection.StartOf Unit:=wdCell, Extend:=wdMove
Selection.EndOf Unit:=wdCell, Extend:=wdExtend
'Именно через Extend
Selection.MoveRight' или .Left или .Down
'Т.е. прямым соответствием нажатию клавиш.
'Только этот вариант работает для "пересекающихся" строк
'проходит только при в режиме отображения страницы
(часто, при фиксированной структуре, можно в десятки раз ускориться через .Cells().Select : Move unit:=wdCell)
Также, строки иногда проще "проходить" путем .Row.Select : Selection.MoveDown

[nopik]

Но вот на границе страниц приходится городить:

Код: Выделить всё

PagMargin = Selection.Cells(1).Range.Information(wdVerticalPositionRelativeToPage)
     Selection.MoveDown
     If (Selection.Information(wdWithInTable)) Then
      Do While (Selection.Cells(1).Range.Information(wdVerticalPositionRelativeToPage) = PagMargin)
      Selection.MoveDown
      Loop
      Selection.StartOf Unit:=wdCell, Extend:=wdMove
      Selection.EndOf Unit:=wdCell, Extend:=wdExtend
     End If