Option Explicit
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()
' подключение
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:
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_______END_______END_______END_______END_______END_______END
End Function
Function IsOpenOfficeConnected() As Boolean
' проверка подключения может уже подключено
Dim DeskTopbis As Object
On Error GoTo IsOpenOfficeConnected_ERR
IsOpenOfficeConnected = False
If isNullEmpty(OpenOffice) Then Exit Function
Set DeskTopbis = OpenOffice.createInstance("com.sun.star.frame.Desktop")
Set DeskTopbis = Nothing
IsOpenOfficeConnected = True
Exit Function
IsOpenOfficeConnected_ERR:
Set OpenOffice = Nothing
End Function
Function isNullEmpty(ByVal thisVariant As Object) As Boolean
' проверка на пустоту и на нуль
isNullEmpty = IsEmpty(thisVariant) Or IsNull(thisVariant)
End Function
Public Function FUN_OOO_OPEN_BOOCK(STR_PATCH_DOCS As String)
'Функция открытия книги ' Спасибо Osmor_у, иначе ничего не вышло бы
Dim OpenParams()
' загрузить открыть документ ("file:///c:/dev/ooo/test.doc", "_blank", 0, arg())
Set OOO_Document = OOO_Desktop.loadComponentFromURL(STR_PATCH_DOCS, "_blank", 0, OpenParams)
End Function
Public Function ConvertToUrl(strFile) As String
'конвертирует путь MS Windows в URL (RFC 1738)
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, Массив);
End Function
Public Function FUN_IN_DOCS(MyCol, MyRow, MyText, str_Aligment)
' вставка в ячейку
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"
OOO_Range.SetValue MyText
End Select
End Function
'
Public Function FUN_Unite(Str_Range, str_Aligment As Long, Str_Merge As Boolean)
'Слияние объединять
'Str_Merge-True объединить ячейки диапазона
'str_Aligment - слева2 справа1 центр3
'str_Aligment - 0 не использовать
'Str_Merge - False разьединить ячейки диапазона
Set OOO_Range = OOO_Sheet.getCellRangeByName(Str_Range)
OOO_Range.Merge (Str_Merge)
If str_Aligment <> 0 Then
OOO_Range.ParaAdjust = str_Aligment
End If
End Function
Public Function FUN_CLEAR_Range(Str_Range As String)
' диапазон на этом листе
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 ячейки диапазона
End Function
Public Function FUN_BORDER_POINT(Str_Range As String)
' бордюры ячеек пример "K1:L11" FUN_MakeCellBorderLine
' получаем ссылку и идём рисовать в = FUN_MakeCellBorderLine
' диапазон на этом листе
Set OOO_Range = OOO_Sheet.getCellRangeByName(Str_Range)
Set OOO_Range.LeftBorder = FUN_MakeCellBorderLine(RGB(0, 0, 0), 0, 5, 0)
Set OOO_Range.RightBorder = FUN_MakeCellBorderLine(RGB(0, 0, 0), 0, 5, 0)
Set OOO_Range.TopBorder = FUN_MakeCellBorderLine(RGB(0, 0, 0), 0, 5, 0)
Set OOO_Range.BottomBorder = FUN_MakeCellBorderLine(RGB(0, 0, 0), 0, 5, 0)
End Function
Public Function FUN_BORDER_CLEAR(Str_Range As String)
' бордюры ячеек пример "K1:L11" FUN_MakeCellBorderLine
' получаем ссылку и идём рисовать в = FUN_MakeCellBorderLine
' диапазон на этом листе
Set OOO_Range = OOO_Sheet.getCellRangeByName(Str_Range)
Set OOO_Range.LeftBorder = FUN_MakeCellBorderLine(RGB(0, 0, 0), 0, 0, 0)
Set OOO_Range.RightBorder = FUN_MakeCellBorderLine(RGB(0, 0, 0), 0, 0, 0)
Set OOO_Range.TopBorder = FUN_MakeCellBorderLine(RGB(0, 0, 0), 0, 0, 0)
Set OOO_Range.BottomBorder = FUN_MakeCellBorderLine(RGB(0, 0, 0), 0, 0, 0)
End Function
Public Function FUN_MakeCellBorderLine(nColor, nInnerLineWidth, nOuterLineWidth, nLineDistance) _
As Object
'Функция создания объекта BorderLine содержащего информацию о линии рамки
'параметры nColor - цвет рамки
'nInnerLineWidth - толщина внутренней линии
' nOuterLineWidth - - толщина внешней линии
' расстояние между внутренней и внешней линией
Dim oSM As Object
Dim oBorderLine As Object
Set oSM = CreateObject("com.sun.star.ServiceManager")
Set oBorderLine = oSM.Bridge_GetStruct("com.sun.star.table.BorderLine")
With oBorderLine
.Color = nColor
.InnerLineWidth = nInnerLineWidth
.OuterLineWidth = nOuterLineWidth
.LineDistance = nLineDistance
End With
Set FUN_MakeCellBorderLine = oBorderLine
End Function
Public Function OOO_IT_IS_SHEET(STR_NAME_SHEET As String) As Boolean
' проверка наличия листа по имени преобразуя имя в индекс OOO_findSheetIndex()
' если такой лист имеется
OOO_IT_IS_SHEET = False
If OOO_findSheetIndex(OOO_Document, STR_NAME_SHEET) <> -1 Then
OOO_IT_IS_SHEET = True
End If
End Function
Function OOO_findSheetIndex(oDoc As Object, sheetName As String) As Integer
'возвращает индекс листа книги переданной в качестве параметра по его имени
Dim i As Integer
For i = 0 To OOO_Document.Sheets.Count - 1
If oDoc.Sheets.getByIndex(i).Name = sheetName Then
OOO_findSheetIndex = i
Exit Function
End If
Next i
OOO_findSheetIndex = -1
End Function
Public Function OOO_DELETE_SHEET(STR_NAME_SHEET As String) As Boolean
'удаляем лист
Call OOO_Document.getSheets.removeByName(STR_NAME_SHEET)
End Function
Public Function FUN_Clear_OOO()
On Error GoTo exit_Function
' очистка переменных OOO
Set OOO_Document = Nothing
Set OOO_Sheet = Nothing
Set OOO_Desktop = Nothing
Set OpenOffice = Nothing
exit_Function:
End Function
|