|
11.10.2004, 20:30
#32733056
Ссылка:
Ссылка на сообщение:
Ссылка с названием темы:
Ссылка на профиль пользователя:
|
|
|
Участник
Откуда: Кемеровская область, г. Белово
Сообщения: 248
Рейтинг:
0
/ 0
|
|
|
|
Нужно экспортировать данные из MSFlexGrid в Word.Table
Делаю в цикле: перетаскиваю значение из каждой ячейки MSFlexGrid в соответствующую ячейку Word.Table. Вот код:
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.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
'/* >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'/* Эксопрт данных из MSFlexGrid в MS Office
Function ExportToOffice()
Dim frmPrint As New frmExportMSOff, oListItems As MSComctlLib.ListItems, oItem As MSComctlLib.ListItem
Dim i As Integer, j As Integer, intColumnCount As Integer, strColumn As String
Dim k As Integer, m As Integer
' заполняем ListView нименованиями колонок
Set oListItems = frmPrint.lvwColumns.ListItems
Set oItem = oListItems.Add(, , "№ строки")
oItem.Checked = False
For i = 1 To GridSearch.Rows - 1
If GridSearch.TextMatrix(i, 8 ) = "1" Then
Set oItem = oListItems.Add(, , GridBrowse.TextMatrix( 0 , i))
oItem.Checked = True
j = j + 1
End If
Next i
frmPrint.Frame1.Caption = "Таблица (" & Trim$(j) & " x " & Trim$(GridBrowse.Rows - 1 ) & ")"
frmPrint.Show vbModal, Me
If Len(frmPrint.Tag) > 0 Then ' в форме frmExportMSOff нажали кнопку "OK"
' определяем количство столбцов для экспорта
For i = 1 To oListItems.Count
If oListItems(i).Checked Then intColumnCount = intColumnCount + 1
Next i
Select Case CInt(GetSetting("OBU", "MS Office", "OfficeApp"))
Case 0 ' экспорт в Word
'создаём новый экземпляр Word-a и создаём новый документ в Word-e
Dim WordApp As New Word.Application, DocWord As Word.Document, TableWord As Word.Table
Set DocWord = WordApp.Documents.Add
' определяем ориентацию страницы
DocWord.PageSetup.Orientation = CInt(GetSetting("OBU", "MS Office", "PageFormat"))
'создаём таблицу во всю ширину области печати текста
Set TableWord = DocWord.Tables.Add(DocWord.Range(), GridBrowse.Rows, intColumnCount)
' нумерация строк
If oListItems( 1 ).Checked Then
TableWord.Cell( 1 , 1 ).Range.Text = "№ строки"
m = 2
For i = 1 To GridBrowse.Rows - 1
TableWord.Cell(i + 1 , 1 ).Range.Text = Str$(i)
Next i
Else
m = 1
End If
' /* заполняем таблицу
' 1. документ - "справочник" или в QBE отмечены все поля на просмотр
If GridBrowse.Cols = GridSearch.Rows Then
j = 2
For i = 1 To GridSearch.Rows - 1
If GridSearch.TextMatrix(i, 8 ) = "1" Then
If oListItems(j).Checked Then
For k = 1 To GridBrowse.Rows - 1
TableWord.Cell(k + 1 , m).Range.Text = GridBrowse.TextMatrix(k, i)
Next k
m = m + 1
End If
j = j + 1
End If
Next i
Else
' 2. документ - QBE отмечены не все поля на просмотр
End If
WordApp.Visible = True
DocWord.Activate
'уничтожаем ссылки на обьект - документ Word, обьект - приложение Word
Set TableWord = Nothing
Set DocWord = Nothing
Set WordApp = Nothing
Case 1 ' экспорт в Excel
'создаём новый экземпляр Excel-a, документ в Excel-e
Dim ExcelApp As New Excel.Application, DocExcel As Excel.Workbook, SheetExcel As Excel.Worksheet
Set DocExcel = ExcelApp.Workbooks.Add
' определяем ориентацию страницы
Set SheetExcel = DocExcel.Worksheets( 1 ) ' Лист 1
SheetExcel.PageSetup.Orientation = CInt(GetSetting("OBU", "MS Office", "PageFormat")) + 1
ExcelApp.Visible = True
DocExcel.Activate
'уничтожаем ссылки на обьект - документ Excel, обьект - приложение Excel
Set SheetExcel = Nothing
Set DocExcel = Nothing
Set ExcelApp = Nothing
End Select
End If
Unload frmPrint
'уничтожаем ссылку на обьект frmExportMSOff
Set frmPrint = Nothing
End Function
Пока таблички маленикие время оработки устраивает. Но если в таблице более 500 строк, НУ ОЧЕНЬ ДОЛГО . Может можно как-нибудь заполнять таблицу Word.Table не по ячейкам а столбцами? |
|
|
