CosmosilaКакие будут ваши предложения?
Вы, случаем, не начальник? :-)
Предложение: Вы начните делать хоть что-то, а мы поможем. Основной алгоритм, наверное, примерно следующий(если так уж хочется своими силами):
-перебираем все рамки и считываем текст, позицию, ширину, высоту;
-загоняем все в словарь, чтобы создать строки;
-в словаре строк - создаем коллекцию столбцов;
-создаем новую таблицу, туда все выгружаем.
Код примерный набросал, но в нем куча доделок нужно(сортировка строк по позиции - как со столбцами); учесть малые таблицы под каждым листом; подкорректировать высоту строк и ширину столбцов; может еще чего).
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
Sub CreateTable()
Dim oS As Frame
Dim sH As String, sV As String, sHeiht As String, sWidth As String, colH As Collection, le As Long, i As Long
Dim avTmp, lMaxColscnt As Long
Dim dicFrames As Object
Dim avItems, avKeys
Dim docNew As Document, oTbl As Table
'словарь рамок
Set dicFrames = CreateObject("scripting.dictionary")
dicFrames.comparemode = 1
On Error Resume Next
For Each oS In ActiveDocument.Frames
sH = oS.HorizontalPosition
sV = oS.VerticalPosition
sHeiht = oS.Height 'вдруг пригодится
sWidth = oS.Width 'вдруг пригодится
avTmp = Array(sH, oS.Range.Text, sHeiht, sWidth)
If dicFrames.Exists(sV) = False Then
Set colH = New Collection
colH.Add avTmp, sH
dicFrames.Add sV, colH
Else
Set colH = dicFrames.Item(sV)
'сортируем столбцы
For i = 1 To colH.Count
If CDbl(sH) < CDbl(colH.Item(i)(0)) Then Exit For
Next
If i > colH.Count Then
colH.Add avTmp, sH
If Err.Number Then
avTmp = Array(sH, avTmp(1) & oS.Range.Text, sHeiht, sWidth)
colH.Item(i) = avTmp
Err.Clear
End If
Else
colH.Add avTmp, sH, Before:=i
If Err.Number Then
avTmp = Array(sH, avTmp(1) & oS.Range.Text, sHeiht, sWidth)
colH.Item(i) = avTmp
Err.Clear
End If
End If
Set dicFrames.Item(sV) = colH
If colH.Count > lMaxColscnt Then
lMaxColscnt = colH.Count
End If
End If
Next
'выгружаем на новую таблицу в новом документе
On Error GoTo 0
avItems = dicFrames.items
avKeys = dicFrames.keys
Set docNew = Documents.Add
Set oTbl = docNew.Tables.Add(docNew.Content, UBound(avKeys), lMaxColscnt)
On Error GoTo 0
For le = LBound(avKeys) To UBound(avKeys)
Set colH = dicFrames.Item(avKeys(le))
For i = 1 To colH.Count
oTbl.Cell(le + 1, i).Range.Text = colH.Item(i)(1)
Next i
Next le
End Sub
