Форумы HiProg.com - MS ACCESS, VBA, VB

 

Ответить на сообщение

Вернуться к теме

Вы отвечаете на сообщение:

ник: час


Public Function FUN_TABLE_IMPORT_ODS(STR_TABLE_NAME As String, STR_CONNECTION As Connection)
' переброс таблицы STR_TABLE_NAME  в  файл OpenOffice
Dim FIEL As ADODB.Field         ' поле
Dim FIEL1 As ADODB.Field        ' поле
Dim rst2 As ADODB.Recordset     ' набор записей
Dim STROKA_ods As Integer
Dim KOLONKA_ods As Integer
Dim OpenParams()

'____
On Error GoTo FUN_TABLE_IMPORT_ODS_Error
'----------------------------------------------------------------------------------------------------------------------------------------------------------------

' создаём путь к создаваемому файлу
GLB_PATCH_EXPORT_DOCS = FUN_Patch_File(GLB_PATCH_EXPORT, STR_TABLE_NAME & ".ods")
' если таковой имеется удаляем
If FUN_FILE_YES_NO(GLB_PATCH_EXPORT_DOCS) = True Then
 FUN_DELETE_FILE_NAME (GLB_PATCH_EXPORT_DOCS)
End If
GLB_PATCH_EXPORT_DOCS = ConvertToUrl(GLB_PATCH_EXPORT_DOCS)

'создаем новый ServiceManager
Call FUN_Connect_OOO
' создаем новую книгу OpenOffice.org Calc
Set OOO_Document = OOO_Desktop.loadComponentFromURL("private:factory/scalc", "_blank", 0, OpenParams)

'получаем ссылку на первый лист новой книги
Set OOO_Sheet = OOO_Document.getSheets().getByIndex(0)
' переименуем лист, в который мы выводили данные
OOO_Sheet.Name = STR_TABLE_NAME
' получим индекс листа
OOO_Index_Sheet = OOO_findSheetIndex(OOO_Document, STR_TABLE_NAME)
' получим ссылку на лист
Set OOO_Sheet = OOO_Document.getSheets().getByIndex(OOO_Index_Sheet)

Set rst2 = New ADODB.Recordset  ' набор записей
rst2.Open "SELECT " & STR_TABLE_NAME & ".* FROM " & STR_TABLE_NAME, STR_CONNECTION, adOpenKeyset, adLockOptimistic
If rst2.EOF = False Then ' если таблица (rst2) не пуста перенос
rst2.MoveFirst
STROKA_ods = 0
KOLONKA_ods = 0
For Each FIEL In rst2.Fields
 Call FUN_IN_DOCS(KOLONKA_ods, STROKA_ods, NZVB(FIEL.Properties(0)), 2)
'Debug.Print cat.GetObjectOwner(STR_TABLE_NAME, adPermObjColumn)
 KOLONKA_ods = KOLONKA_ods + 1
Next FIEL

STROKA_ods = 1
KOLONKA_ods = 0

    
    Do While Not rst2.EOF           ' заполняем
        For Each FIEL1 In rst2.Fields        'значения
        If NZVB(FIEL1) <> "" Then
        Call FUN_IN_DOCS(KOLONKA_ods, STROKA_ods, CStr(FIEL1), 2)
'        Else
'        Call FUN_IN_DOCS(KOLONKA_ods, STROKA_ods, "-----", 2)
        End If
        KOLONKA_ods = KOLONKA_ods + 1
        Next FIEL1
    STROKA_ods = STROKA_ods + 1
    KOLONKA_ods = 0
    rst2.MoveNext
    Loop
 End If
rst2.Close
Set rst2 = Nothing
'
''сохраняем созданную книгу в формате
''Электронной таблицы OpenDokument GLB_PATCH_EXPORT_DOCS
'
''сохраняем созданную книгу
'Call OOO_Document.storeToURL(GLB_PATCH_EXPORT_DOCS, OpenParams)
''сохраняем созданную книгу в формате PDF
'''в корне диска С: с именем SampleOOo.PDF
''Set prop(0) = MakePropertyValue("FilterName", "calc_pdf_Export")
''Call oBook.storeToURL(GLB_PATCH_EXPORT_DOCS, prop)
''закрываем созданную книгу
'Call OOO_Document.Close(False)
'
'Set OOO_Document = Nothing
'Set OOO_Sheet = Nothing
'Set OOO_Desktop = Nothing
'Set OpenOffice = Nothing
''Set OOO_Document = OOO_Desktop.loadComponentFromURL(GLB_PATCH_EXPORT_DOCS, "_default", 0, OpenParams)
''Открываем только что сохраненную книгу
'Call FUN_OOO_OPEN_BOOCK(GLB_PATCH_EXPORT_DOCS)


'----------------------------------------------------------------------------------------------------------------------------------------------------------------
On Error GoTo 0
Exit Function
FUN_TABLE_IMPORT_ODS_Error:
Error_String = Err.Description
Call FUN_IN_TXT(FUN_Patch_File(App.Path, "Error.txt"), Now() & " _модуль " & "TABLE_MOD" & " _процедура " & "FUN_TABLE_IMPORT_ODS" & " ..ошибка." & Error_String)
'_______END_______END_______END_______END_______END_______END_______END

End Function




Ваше имя:

Пароль:

Цитировать: [quote][/quote] Код: [code][/code]
Жирный: [b][/b] Наклонный: [i][/i]
URL: [url][/url] 

Сообщение:

 Размер файла не более 50 Кбт. Большие файлы можно размещать на www.slil.ru

Прикрепить:

 

Для вставки смайлов в текст щелкните по значку.