Страница 1 из 1

Word. Преобразование таблиц

Добавлено: 03 фев 2009, 12:10
seergy
Существуют документ Word в него из экселя вставляется таблица с одним столбцом объединённым из 8столбцов и 8 столбцов.( см файл до преобразования.doc)

С помощью преоброзований в ручную получаю следующее ( см файл после преобразования.doc) с помощью записанных макросов :
1) Разделение таблиц : Selection.InsertBreak Type:=wdPageBreak

2) В ручную таблицы с одним столбцом преобразуются в текст : Selection.Rows.ConvertToText Separator:=wdSeparateByTabs, NestedTables:= True

Следующий макрос может решить эту проблему со всеми таблицами в документе . Разделителем между извлеченным текстом таблиц служит символ абзаца (пустая строка). Однако он не подходит.

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

Sub AllTblsToText()
'все таблицы в текст
Dim tbl As Table
For Each tbl In ActiveDocument.Tables
   tbl.ConvertToText (wdSeparateByParagraphs)
Next tbl
End Sub
Вопрос:
1) Нужен макрос, который циклично найдёт строки начинающиеся на "Расчёт", "63", "L" и применит макрос Selection.InsertBreak Type:=wdPageBreak - т. е. разделит одну таблицу на несколько таблиц.

2) далее нужно, что бы макрос все таблицы , где один столбец выделил и преобразовал в текст с помощью Selection.Rows.ConvertToText Separator:=wdSeparateByTabs, NestedTables:= True.
а таблицы, где 8 столбцов сохраняются.
Спасибо заранее ...
С уважением....

Re: Word. Преобразование таблиц

Добавлено: 06 фев 2009, 10:03
seergy
Ну очень прошу в VBA Worde не селён...
Макрорекордером кусочки макросов собрал циклический поиск по условию и формирование таблиц не получается...
Хотя бы ссылку дайте на др. источник...
С уважением..

Re: Word. Преобразование таблиц

Добавлено: 06 фев 2009, 23:18
Naeel Maqsudov
Попробуйте вот это

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

Sub a()
  Dim T As Rows, R As Row, Rws() As Row, r1 As Range
  Set T = ThisDocument.Tables(1).Rows
  n = T.Count
  ReDim Rws(n)
  For i = 1 To n
    Set Rws(i) = T(i)
  Next
  For i = 1 To n
    With Rws(i)
      If .Range.Text Like "Расч*" Then .Range.InsertBreak wdPageBreak
      If .Cells.Count = 1 Then .ConvertToText
    End With
  Next
End Sub

Re: Word. Преобразование таблиц

Добавлено: 09 фев 2009, 06:42
seergy
Naeel Maqsudov
Очень выручили ...
С уважением....