|
Доброго времени суток, Посетитель!
|
|
|
|
|
|
|
|
|
вид форума:
|
| |
|
|
| | Всем привет !
у меня задача - обрабатывать OpenOffice электронные таблицы макросами из VBA.
Где можно почитать, как использовать методы этого OpenOffice ?
Статью osmor-а (http://hiprog.com/index.php?option=com_content&task=view&id=251661586&Itemid=35) прочитал и частично использовал, но нужны еще и другие методы,например, копирование содержимого всего листа на новый лист и проч.
Буду признателен за ссылочки... | |
| |
| |
| |
|
|
| | Для меня все очень не просто.
Полного писания модели (понятного мне) я так и не нашел.
в основном все брал от сюда
http://www.oooforum.org/forum/index.phtml?sid=35c6c7016083cf942d467c12175c15d8
Есть еще пара книг в электронном виде, не сильно хороших, но все же. (завтра кину)
давай спрашивай здесь конкретные вопросы - будем вместе решать.
У мужика на работе есть книга
http://www.softkey.ru/catalog/program.php?ID=45019&site=9206
Но я ее еще не смотрел даже... OOO мне сейчас вроде не нужен. | |
| |
| |
| |
|
|
| | Спасибо, Олег !
я и сам пытаюсь что-то нарыть, но тяжело :(
Книги в основном о работе в самом опен-офисе, а так чтобы из VBA работать с документом, что-то мало.
Сейчас проблема такая:
есть calc-документ ООО, в нем два листа.
нужно всю инфу скопировать с первого листа на второй, чтобы там ее править. | |
| |
| |
| |
|
|
| | Можно перезалить в таблицу аксес, а потом вылить в нужное место.
Можно сразу открыть документ и работать с двумя листами.
Чё не понятно.... | |
| |
| |
| |
|
|
| | переменные
Public OpenOffice As Object ' сервис менеджер
Public OOO_Desktop As Object ' рабочий стол
Public OOO_Document As Object ' документ, книга
Public OOO_Sheet As Object ' лист
Public OOO_Index_Sheet As Long ' индекс листа
Public OOO_Range As Object ' диапазон ячеек
|
| |
| |
| |
| |
|
|
| |
Public Function FUN_Connect_OOO() As Boolean
' подключение
FUN_Connect_OOO = True
On Error GoTo FUN_Connect_OOO_Error
'----------------------------------------------------------------------------------------------------------------------------------------------------------------
'If IsOpenOfficeConnected() Then Exit Function
Set OpenOffice = CreateObject("com.sun.star.ServiceManager")
Set OOO_Desktop = OpenOffice.createInstance("com.sun.star.frame.Desktop") '
Set OOoIntrospection = CreateUnoService("com.sun.star.beans.Introspection")
'----------------------------------------------------------------------------------------------------------------------------------------------------------------
On Error GoTo 0
Exit Function
FUN_Connect_OOO_Error:
FUN_Connect_OOO = False
Set OpenOffice = Nothing
Error_String = Err.Description
Call FUN_IN_TXT(FUN_Patch_File(App.Path, "Error.txt"), Now() & " _модуль " & "OOO_MOD" & " _
процедура " & "FUN_Connect_OOO" & " ..ошибка." & Error_String)
End Function
|
| |
| |
| |
| |
|
|
| |
Public Function FUN_OOO_OPEN_BOOCK(STR_PATCH_DOCS As String)
'Функция открытия книги ' Спасибо Osmor_у, иначе ничего не вышло бы
On Error GoTo FUN_OOO_OPEN_BOOCK_Error
'----------------------------------------------------------------------------------
On Error GoTo BLANK
Dim OpenParams()
Call FUN_Connect_OOO
' загрузить открыть документ ("file:///c:/dev/ooo/test.doc", "_blank", 0, arg())
Set OOO_Document = OOO_Desktop.loadComponentFromURL(STR_PATCH_DOCS, "_default", 0, OpenParams)
Exit Function
BLANK:
FUN_Connect_OOO
Set OOO_Document = OOO_Desktop.loadComponentFromURL(STR_PATCH_DOCS, "_blank", 0, OpenParams)
'----------------------------------------------------------------------------------
On Error GoTo 0
Exit Function
FUN_OOO_OPEN_BOOCK_Error:
Call FUN_IN_TXT(FUN_Patch_File(App.Path, "Error.txt"), "Error " & Err.Number & " (" & Err.Description & ") in procedure FUN_OOO_OPEN_BOOCK of Module OOO_MOD")
End Function
|
| |
| |
| |
| |
|
|
| |
Public Function FUN_CREATE_COMMODITY_CHECK() As Boolean
' создание документа "Товарный_Чек" Улучшенное
Dim OpenParams()
Dim rst As ADODB.Recordset
Dim PP As Long
' Спасибо Osmor_у, иначе ничео не вышло бы
On Error GoTo FUN_CREATE_COMMODITY_CHECK_Error
'----------------------------------------------------------------------------------
FUN_CREATE_COMMODITY_CHECK = False
' если такого листа нет
If OOO_findSheetIndex(OOO_Document, "Товарный_Чек") = -1 Then
Call MsgBox("В документах не обнаружен лист <<Товарный_Чек>>", vbCritical)
Exit Function
End If
' если такого листа нет
OOO_Index_Sheet = OOO_findSheetIndex(OOO_Document, "Товарный_Чек") ' получим индекс листа
Set OOO_Sheet = OOO_Document.getSheets().getByIndex(OOO_Index_Sheet)
OOO_Sheet.CharWeight = 75
OOO_Sheet.CharHeight = 10
OOO_Sheet.CharFontName = "TimesNewRoman" ' Наименование шрифта
' очистить диапазон под новые данные
Call FUN_CLEAR_Range("A" & PP + 1 & ":J" & 41)
' очистить бордюры диапазона
Call FUN_BORDER_CLEAR("A" & PP + 1 & ":J" & 41)
PP = 0
Call FUN_IN_DOCS("0", PP, "Организация: " & GLB_FIRMA, 2)
PP = PP + 1
Call FUN_Unite("A" & PP & ":I" & PP, 2, True) 'слияние PP на единицу болше (чёт с 1)
PP = PP + 1
Set OOO_Range = OOO_Sheet.getCellRangeByPosition(0, PP, 6, PP)
OOO_Range.CharHeight = 18 ' size Размер шрифта
Call FUN_IN_DOCS("0", PP, "Товарный чек № " & GLB_DOC_NUMBER & " от " & GLB_DOC_DATE, 3)
PP = PP + 1
Call FUN_Unite("A" & PP & ":I" & PP, 3, True) 'слияние PP на единицу больше (чёт с 1)
'' задаём ширину колонокSet OOO_Colonka =
OOO_Sheet.getColumns().getByIndex(0).Width = 700
OOO_Sheet.getColumns().getByIndex(5).Width = 1700
OOO_Sheet.getColumns().getByIndex(6).Width = 1700
OOO_Sheet.getColumns().getByIndex(8).Width = 2800
Set rst = New ADODB.Recordset ' набор записей
' открываем всю группу в rst.Open транзакции
rst.Open "SELECT USERS_TRANSACTIONS_TBL.* From USERS_TRANSACTIONS_TBL Where (((USERS_TRANSACTIONS_TBL.ID_GROUP_TRANSACTION) = '" & GLB_ID_GROUP_DOC & "')) ", GLB_CONNECTION, adOpenKeyset, adLockOptimistic
If rst.RecordCount = 0 Then Exit Function
If Not rst.BOF Then rst.MoveFirst
PP = PP + 1
Do While Not rst.EOF ' заполняем наименованиями
Call FUN_IN_DOCS("0", PP, PP - 3, 3) ' № по порядку
Call FUN_IN_DOCS("1", PP, NZVB(rst("COMMODITY_NAME")), 2)
Call FUN_IN_DOCS("5", PP, NZVB(rst("METAGE")), 3)
Call FUN_IN_DOCS("6", PP, NZVAL(rst("AMOUNT_TRANZACTION")), 3)
Call FUN_IN_DOCS("7", PP, FUN_Currency_IN_String_DOCS(NZVB(rst("PRICE"))), 3)
Call FUN_IN_DOCS("8", PP, FUN_Currency_IN_String_DOCS(NZVB(rst("PRICE")) * NZVAL(rst("AMOUNT_TRANZACTION"))), 3)
PP = PP + 1
Call FUN_Unite("B" & PP & ":E" & PP, 2, True) 'слияние
rst.MoveNext
Loop
Call FUN_Unite("A" & PP + 1 & ":F" & PP + 1, 3, True) ' слияние
Call FUN_IN_DOCS("0", PP, "Всего: ", 3)
'Заполняем PP строку суммы по колонкам
Call FUN_IN_DOCS("6", PP, FUN_AMOUNT_DOC, 3)
Call FUN_IN_DOCS("8", PP, FUN_Currency_IN_String_DOCS(FUN_PODITOG_DOC), 3)
Set OOO_Range = OOO_Sheet.getCellRangeByPosition(0, PP, 8, PP)
OOO_Range.CharWeight = 150
Call FUN_BORDER_POINT("A5:I" & PP + 1, 5) ' рисуем бордюрs на все строки
PP = PP + 2
Call FUN_Unite("A" & PP & ":I" & PP, 3, True) ' слияние
Set OOO_Range = OOO_Sheet.getCellRangeByPosition(0, PP, 8, PP)
OOO_Range.IsTextWrapped = True ' Переносить по словам
Call FUN_IN_DOCS("0", PP - 1, "Сумма прописью: " & NumStr(FUN_PODITOG_DOC, True) & " Без налога НДС. ", 2)
PP = PP + 3
Call FUN_Unite("A" & PP & ":I" & PP, 3, True) 'слияние
Call FUN_IN_DOCS("0", PP - 1, "Отпустил ________________________ " & GLB_USER_NAME, 2)
rst.Close
Set rst = Nothing
'Set OOO_Sheet = Nothing
'Set OOO_Document = Nothing
FUN_CREATE_COMMODITY_CHECK = True
'----------------------------------------------------------------------------------
On Error GoTo 0
Exit Function
FUN_CREATE_COMMODITY_CHECK_Error:
Call FUN_IN_TXT(FUN_Patch_File(App.Path, "Error.txt"), "Error " & Err.Number & " (" & Err.Description & ") in procedure FUN_CREATE_COMMODITY_CHECK of Module DOCS_MOD")
End Function
|
| |
| |
| |
| |
|
|
| |
Public Function FUN_LOAD_DIRECTORY_COMMODITY(STR_PATH As String) As Boolean
' Загрузка справочника товаров
Dim OpenParams()
Dim RST_GROUP As ADODB.Recordset
Dim RST_COMMODITY As ADODB.Recordset
Dim PP As Long ' номер строки
Dim GROUP_NUMBER As Long ' присвоим номер загружаемой группе
Dim GROUP_NAME As String ' имя группы
Dim STR_IN As String ' загружаемое значение из ячейки
Dim PUSTO As Long ' количество пустых строк
' Спасибо Osmor_у, иначе ничео не вышло бы
On Error GoTo FUN_LOAD_DIRECTORY_COMMODITY_Error
'----------------------------------------------------------------------------------
FUN_LOAD_DIRECTORY_COMMODITY = False
' если таковой не имеется сообщаем
If FUN_FILE_YES_NO(STR_PATH) = False Then
MsgBox "Файл " & STR_PATH & " не найден!!!"
Exit Function
End If
STR_PATH = ConvertToUrl(STR_PATH)
MsgBox "Пожалуйста нажмите ок и ждите дальнейшего сообщения..."
OOO_Index_Sheet = -1
' открываем книгу OpenOffice.org Calc
Call FUN_OOO_OPEN_BOOCK(STR_PATH)
If OOO_findSheetIndex(OOO_Document, "Остатки") <> -1 Then
' получим индекс листа
OOO_Index_Sheet = OOO_findSheetIndex(OOO_Document, "Остатки")
GoTo Dalee_Dalee
End If
' попытка найти лист NOMENKLATURA
If OOO_findSheetIndex(OOO_Document, "NOMENKLATURA") = -1 Then
' лист номенклатура "NOMENKLATURA" - не найден.
Call MESS("Листы (Остатки или NOMENKLATURA) - не найдены.")
' &" ' красный
'
'
Exit Function
Else
' получим индекс листа
OOO_Index_Sheet = OOO_findSheetIndex(OOO_Document, "NOMENKLATURA")
End If
Dalee_Dalee:
' получим ссылку на лист
Set OOO_Sheet = OOO_Document.getSheets().getByIndex(OOO_Index_Sheet)
' набор групп
Set RST_GROUP = New ADODB.Recordset
' очистка таблицы COMMODITY_GROUP_TB
Call FUN_CLEAR_TABLE("COMMODITY_GROUP_TBL", GLB_CONNECTION)
' открываем таблицу групп
RST_GROUP.Open "SELECT COMMODITY_GROUP_TBL.* From COMMODITY_GROUP_TBL ", GLB_CONNECTION, adOpenKeyset, adLockOptimistic
If RST_GROUP.RecordCount <> 0 Then
' очистка таблицы COMMODITY_GROUP_TB
Call FUN_CLEAR_TABLE("COMMODITY_GROUP_TBL", GLB_CONNECTION)
End If
' набор товаров
Set RST_COMMODITY = New ADODB.Recordset
' очистка таблицы COMMODITY_TBL
Call FUN_CLEAR_TABLE("COMMODITY_TBL", GLB_CONNECTION)
' открываем таблицу товаров
RST_COMMODITY.Open "SELECT COMMODITY_TBL.* From COMMODITY_TBL ", GLB_CONNECTION, adOpenKeyset, adLockOptimistic
If RST_COMMODITY.RecordCount <> 0 Then
' очистка таблицы COMMODITY_TBL
Call FUN_CLEAR_TABLE("COMMODITY_TBL", GLB_CONNECTION)
End If
If RST_COMMODITY.RecordCount = 0 Then
GROUP_NUMBER = 0
For PP = 1 To 10
STR_IN = ""
Set OOO_Range = OOO_Sheet.getCellByPosition(0, PP)
STR_IN = OOO_Range.GetString
If InStr(1, STR_IN, "Группа", vbTextCompare) <> 0 Then Exit For
Next PP
For PP = PP To 100000
STR_IN = ""
Set OOO_Range = OOO_Sheet.getCellByPosition(0, PP)
If OOO_Range.Value = 0 Then
STR_IN = OOO_Range.GetString
Else
STR_IN = OOO_Range.Value
End If
' пошли пустые строки, если пустых будет более чем , тогда конец загрузке
If STR_IN = "" Then
PUSTO = PUSTO + 1
GoTo Dalee
End If
'сделать первую букву каждого слова заглавной
' If IsNull(STR_IN) = False Then
' STR_IN = StrConv(STR_IN, vbProperCase)
' End If
' пошли пустые строки
If InStr(1, STR_IN, "Группа", vbTextCompare) <> 0 Then ' это группа
If InStr(1, STR_IN, "7Группа", vbTextCompare) <> 0 Then ' это группа
STR_IN = Mid(STR_IN, 2)
End If
RST_GROUP.AddNew
GROUP_NAME = STR_IN
RST_GROUP("GROUP_NAME") = STR_IN
RST_GROUP("USER_NAME") = GLB_USER_NAME
RST_GROUP("DATE_RECORDS") = Date
RST_GROUP.Update
GROUP_NUMBER = RST_GROUP("GROUP_NUMBER")
Else
RST_COMMODITY.AddNew
' Идентификатор товара.
Set OOO_Range = OOO_Sheet.getCellByPosition(15, PP)
STR_IN = ""
If OOO_Range.Value = 0 Then
STR_IN = OOO_Range.GetString
Else
STR_IN = OOO_Range.Value
End If
If NZVB(STR_IN) <> "" Then
' товар уже с идентификатором (не новый) изменим данные
RST_COMMODITY("ID_COMMODITY") = STR_IN
Else
' товар новый
RST_COMMODITY("ID_COMMODITY") = FUN_GENERATE
End If
' Наименование
Set OOO_Range = OOO_Sheet.getCellByPosition(0, PP)
STR_IN = ""
If OOO_Range.Value = 0 Then
STR_IN = OOO_Range.GetString
Else
STR_IN = OOO_Range.Value
End If
'сделать первую букву каждого слова заглавной
' If IsNull(STR_IN) = False Then
' STR_IN = StrConv(STR_IN, vbProperCase)
' End If
RST_COMMODITY("GROUP_NUMBER") = RST_GROUP("GROUP_NUMBER")
RST_COMMODITY("GROUP_NAME") = GROUP_NAME
RST_COMMODITY("COMMODITY_NAME") = STR_IN
RST_COMMODITY("COMMODITY_NAME_IN_KKM") = STR_IN
' Цена товара.
Set OOO_Range = OOO_Sheet.getCellByPosition(8, PP)
STR_IN = ""
If OOO_Range.Value = 0 Then
STR_IN = OOO_Range.GetString
Else
STR_IN = OOO_Range.Value
End If
RST_COMMODITY("PRICE_COMMODITY") = STR_IN
' Ед. изм
Set OOO_Range = OOO_Sheet.getCellByPosition(9, PP)
STR_IN = ""
If OOO_Range.Value = 0 Then
STR_IN = OOO_Range.GetString
Else
STR_IN = OOO_Range.Value
End If
RST_COMMODITY("METAGE") = STR_IN
' Цена закуп.
Set OOO_Range = OOO_Sheet.getCellByPosition(10, PP)
STR_IN = ""
If OOO_Range.Value = 0 Then
STR_IN = OOO_Range.GetString
Else
STR_IN = OOO_Range.Value
End If
RST_COMMODITY("OPTO_PRICE") = Val(STR_IN)
' Описание производитель
Set OOO_Range = OOO_Sheet.getCellByPosition(11, PP)
STR_IN = ""
If OOO_Range.Value = 0 Then
STR_IN = OOO_Range.GetString
Else
STR_IN = OOO_Range.Value
End If
RST_COMMODITY("DESCRIPTION") = STR_IN
' Минимальный остаток
Set OOO_Range = OOO_Sheet.getCellByPosition(12, PP)
STR_IN = ""
If OOO_Range.Value = 0 Then
STR_IN = OOO_Range.GetString
Else
STR_IN = OOO_Range.Value
End If
RST_COMMODITY("MINIMUM") = Val(STR_IN)
' Количество
Set OOO_Range = OOO_Sheet.getCellByPosition(13, PP)
STR_IN = ""
If OOO_Range.Value = 0 Then
STR_IN = OOO_Range.GetString
Else
STR_IN = OOO_Range.Value
End If
RST_COMMODITY("AMOUNT") = Val(STR_IN)
' ' штрихкод
Set OOO_Range = OOO_Sheet.getCellByPosition(16, PP)
STR_IN = ""
If OOO_Range.Value = 0 Then
STR_IN = OOO_Range.GetString
Else
STR_IN = OOO_Range.Value
End If
RST_COMMODITY("SHTRIHKOD") = STR_IN
RST_COMMODITY.Update ' обновить
End If
Dalee:
' пошли пустые строки
If PUSTO >= 20 Then Exit For
Next PP
FUN_LOAD_DIRECTORY_COMMODITY = True
End If
'
' заполняем наименованиями групп товаров
RST_GROUP.Close
Set RST_GROUP = Nothing
RST_COMMODITY.Close
Set RST_COMMODITY = Nothing
'закрываем созданную книгу
Call OOO_Document.Close(False)
Set OOO_Document = Nothing
Set OOO_Sheet = Nothing
Set OOO_Desktop = Nothing
Set OpenOffice = Nothing
'----------------------------------------------------------------------------------
On Error GoTo 0
Exit Function
FUN_LOAD_DIRECTORY_COMMODITY_Error:
Call FUN_IN_TXT(FUN_Patch_File(App.Path, "Error.txt"), "Error " & Err.Number & " (" & Err.Description & ") in procedure FUN_LOAD_DIRECTORY_COMMODITY of Module DOCS_MOD")
End Function
|
| |
| |
| |
| |
|
|
| |
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
|
| |
| |
| |
| |
|
|
| | Таки, пока хватит,
нужно осмыслить и попробовать что-нибудь навоять.
:) | |
| |
| |
| |
|
|
| | тута не все используемые функции
FUN_IN_DOCS - например
если какая нужна - пиши..... выложу.  | |
| |
| |
| |
|
|
| | В продолжение темы (osmor, час или кто еще в теме...).
Как заставить работать в vba этот код
Никак не могу сообразить :(
Dim Doc As Object
Dim Sheet As Object
Dim CellRangeAddress As New com.sun.star.table.CellRangeAddress
Dim CellAddress As New com.sun.star.table.CellAddress
Doc = StarDesktop.CurrentComponent
Sheet = Doc.Sheets(0)
CellRangeAddress.Sheet = 0
CellRangeAddress.StartColumn = 1
CellRangeAddress.StartRow = 1
CellRangeAddress.EndColumn = 2
CellRangeAddress.EndRow = 2
CellAddress.Sheet = 0
CellAddress.Column = 0
CellAddress.Row = 5
Sheet.moveRange(CellAddress, CellRangeAddress)
|
| |
| |
| |
| |
|
|
| | А че надо сделать ?
Вернее чё код должен делать?
А то пока одни указания диапазонов........ точнее даже точек тасазать........ | |
| |
| |
| |
|
|
| | Этот код вроде как должен удалить область ячеек
Не получается объявить это
Dim CellRangeAddress As New com.sun.star.table.CellRangeAddress
Dim CellAddress As New com.sun.star.table.CellAddress | |
| |
| |
| |
|
|
| | функция:
Public Function FUN_CLEAR_Range(Str_Range As String)
' диапазон на этом листе
On Error GoTo FUN_CLEAR_Range_Error
'----------------------------------------------------------------------------------
Set OOO_Range = OOO_Sheet.getCellRangeByName(Str_Range)
' очистка всех значений в диапазоне
OOO_Range.clearContents (1 Or 2 Or 4) 'FlagsVALUE = 1 FlagsDATETIME = 2 FlagsSTRING = 4
OOO_Range.Merge (False) ' объединить-true разьединить - False ячейки диапазона
'----------------------------------------------------------------------------------
On Error GoTo 0
Exit Function
FUN_CLEAR_Range_Error:
Call FUN_IN_TXT(FUN_Patch_File(App.Path, "Error.txt"), "Error " & Err.Number & " (" & Err.Description & ") in procedure FUN_CLEAR_Range of Module OOO_MOD")
End Function
|
| |
| |
| |
| |
|
|
| | Вызов:
' очистить диапазон под новые данные
Call FUN_CLEAR_Range("A" & PP & ":J" & 41)
|
где PP - номер строки для ячейки А | |
| |
| |
| |
 5 Кб. |
|
| | Не работает, будь она не ладна.
В VB выдает ошибку (см. картинку)
Чего-то не хватает....
Все объявления вроде как сделаны
Ломается на этой строке:
Set oRange = oSheet.getCellRangeByName(sRange) | |
| |
| |
| |
|
|
| | а на какую библиотеку ты ссылку ставишь что бы получить
New com.sun.star.table.CellRangeAddress
?
Кстати видел мой код про копирование листов? Работает? | |
| |
| |
| |
|
|
| | давай сначала
объявим переменные
Public OpenOffice As Object ' сервис менеджер
Public OOO_Desktop As Object ' рабочий стол
Public OOO_Document As Object ' документ, книга
Public OOO_Sheet As Object ' лист
Public OOO_Index_Sheet As Long ' индекс листа
Public OOO_Range As Object ' диапазон ячеек
|
| |
| |
| |
| |
|
|
| |
Public Function FUN_OOO_OPEN_BOOCK(STR_PATCH_DOCS As String)
'Функция открытия книги ' Спасибо Osmor_у, иначе ничего не вышло бы
On Error GoTo FUN_OOO_OPEN_BOOCK_Error
'----------------------------------------------------------------------------------
On Error GoTo BLANK
Dim OpenParams()
Call FUN_Connect_OOO
' загрузить открыть документ ("file:///c:/dev/ooo/test.doc", "_blank", 0, arg())
Set OOO_Document = OOO_Desktop.loadComponentFromURL(STR_PATCH_DOCS, "_default", 0, OpenParams)
Exit Function
BLANK:
FUN_Connect_OOO
Set OOO_Document = OOO_Desktop.loadComponentFromURL(STR_PATCH_DOCS, "_blank", 0, OpenParams)
'----------------------------------------------------------------------------------
On Error GoTo 0
Exit Function
FUN_OOO_OPEN_BOOCK_Error:
Call FUN_IN_TXT(FUN_Patch_File(App.Path, "Error.txt"), "Error " & Err.Number & " (" & Err.Description & ") in procedure FUN_OOO_OPEN_BOOCK of Module OOO_MOD")
End Function
|
| |
| |
| |
| |
|
|
| |
Public Function FUN_Connect_OOO() As Boolean
' подключение
FUN_Connect_OOO = True
On Error GoTo FUN_Connect_OOO_Error
'--------------------------------------------------------------------------------------------------------------------------------------------------------
Set OpenOffice = CreateObject("com.sun.star.ServiceManager")
Set OOO_Desktop = OpenOffice.createInstance("com.sun.star.frame.Desktop") ' Set OOoIntrospection = CreateUnoService("com.sun.star.beans.Introspection")
'----------------------------------------------------------------------------------------------------------------------------------------------------------------
On Error GoTo 0
Exit Function
FUN_Connect_OOO_Error:
FUN_Connect_OOO = False
Set OpenOffice = Nothing
Error_String = Err.Description
Call FUN_IN_TXT(FUN_Patch_File(App.Path, "Error.txt"), Now() & " _модуль " & "OOO_MOD" & " _процедура " & "FUN_Connect_OOO" & " ..ошибка." & Error_String)
End Function
|
| |
| |
| |
| |
|
|
| | Конвертер пути
Иначе ООО не поймёт - где лист, какой путь..........
Public Function ConvertToUrl(strFile) As String
'конвертирует путь MS Windows в URL (RFC 1738)
On Error GoTo ConvertToUrl_Error
'----------------------------------------------------------------------------------
strFile = Replace(strFile, "\", "/")
' strFile = Replace(strFile, ":", "|")
strFile = Replace(strFile, " ", "%20")
strFile = "file:///" + strFile
ConvertToUrl = strFile
'"file:///C:/1.odt", "_blank", 0, NoArg)
'("file://localhost/C:\TEMP\Ostatki.xls", "_blank", 0, Массив);
'----------------------------------------------------------------------------------
On Error GoTo 0
Exit Function
ConvertToUrl_Error:
Call FUN_IN_TXT(FUN_Patch_File(App.Path, "Error.txt"), "Error " & Err.Number & " (" & Err.Description & ") in procedure ConvertToUrl of Module OOO_MOD")
End Function
|
пример использованя
STR_PATH = ConvertToUrl(STR_PATH) | |
| |
| |
| |
|
|
| | и последняя для теста функцаЯ
Public Function FUN_IN_DOCS(MyCol, MyRow, MyText, str_Aligment)
' вставка в ячейку
On Error GoTo FUN_IN_DOCS_Error
'----------------------------------------------------------------------------------
Set OOO_Range = OOO_Sheet.getCellByPosition(MyCol, MyRow)
OOO_Range.ParaAdjust = str_Aligment '3 ' слева2 справа1 центр3
Select Case TypeName(MyText)
Case "String"
If Left(MyText, 1) = "=" Then
OOO_Range.SetFormula MyText
Else
OOO_Range.setString MyText
End If
Case "Double", "Integer", "Long", "Currency", "Single"
OOO_Range.SetValue MyText
End Select
'----------------------------------------------------------------------------------
On Error GoTo 0
Exit Function
FUN_IN_DOCS_Error:
Call FUN_IN_TXT(FUN_Patch_File(App.Path, "Error.txt"), "Error " & Err.Number & " (" & Err.Description & ") in procedure FUN_IN_DOCS of Module OOO_MOD")
End Function
'
|
| |
| |
| |
| |
|
|
| | http://am.rusimport.ru/MsAccess/topic.aspx?id=737 | |
| |
| | |
|
HiProg.com - Технологии программирования
|
