Lotus + Openoffce На Linux И Win

%REM
Class Name: Open Office Calc
Created: 29.12.2011
%END REM
Public Class OO_Calc
Private Obj As Variant
Private ObjServiceManager As Variant
Private ObjCoreReflection As Variant
Private ObjDesktop As Variant
Private Sheet As Variant
Private RangeObj As Variant
Private Session As NotesSession
Private NoArgs() As Variant
Private pLastError As String
Private pLastErrorLine As Integer
Private pLastErrorCode As Integer
 
Public Property Set Value(Pos As String) As String
Call SetValue(Pos, Value)
End Property
 
Public Property Get LastError As Variant
LastError = pLastError
End Property
 
Public Property Get LastErrorCode As Variant
LastErrorCode = pLastErrorCode
End Property
 
Public Property Get LastErrorLine As Variant
pLastErrorLine = pLastErrorLine
End Property
 
Public Property Get Range As Variant
Set Range = RangeObj
End Property
 
Create Objects
Public Sub New()
On Error GoTo ERRLINE
Set Session = New NotesSession
Set ObjServiceManager = CreateObject("com.sun.star.ServiceManager")
Set ObjCoreReflection = objServiceManager.createInstance("com.sun.star.reflection.CoreReflection")
Set ObjDesktop = objServiceManager.createInstance("com.sun.star.frame.Desktop")
 
Set Obj = objDesktop.loadComponentFromURL("private:factory/scalc", "_blank", 0, NoArgs)
 
End If
 
EXT_:
Exit Sub
ERRLINE:
pLastError = Error$
pLastErrorLine = Erl
pLastErrorCode = Err
MsgBox "Ошибка: " & Error$ & " line: " & Erl,16,"Class: Open Office Calc"
Resume EXT_
End Sub
 
Public Function Sheets(index) As Variant
On Error GoTo ERRLINE
Dim Res(1) As String
 
If IsNumeric(Index) Then
Set Sheet = Obj.getSheets().getByIndex(Index)
Else
Set Sheet = Obj.getSheets().getByName(Index)
End If
 
Res(0) = "1"
Res(1) = ""
EXT_:
SetSheets = Res
Exit Function
ERRLINE:
Res(0) = "0"
Res(1) = "SetSheets - Code: " & CStr(Err) & " Text: " & Error$ & " Line: " & CStr(Erl)
Print Res(1)
pLastError = Error$
pLastErrorLine = Erl
pLastErrorCode = Err
Resume EXT_
End Function
 
convert To URL For WIN
Private Function ConvertToUrl(strFile) As String
strFile = Replace(strFile, "\", "/")
strFile = Replace(strFile, ":", "|")
strFile = Replace(strFile, " ", "%20")
strFile = "file:///" + strFile
ConvertToUrl = strFile
End Function
 
Save Doc
Public Function Save(Path) As Boolean
On Error GoTo err_
Dim aNoArgs()
If Path = "" Then
Path = "C:\" & CStr(Date)
Path = Replace(Path, ".", "_")
Path = Path + ".ods"
End If
Call Obj.storeToURL(ConvertToUrl(Path), aNoArgs)
Save = True
ext_:
Exit Function
err_:
Save = False
pLastError = Error$
pLastErrorLine = Erl
pLastErrorCode = Err
Resume ext_
End Function
 
SetValue
Private Sub SetValue(Pos, Value As String)
On Error Resume Next
Dim xy
If CStr(Pos)="" Then Error 5000, {Param Range is empty}
xy = Split(Pos, ":")
If UBound(xy) <> 1 Then Error 5001, {Param Range is error}
 
ForAll x In xy
If Not IsNumeric(x) Then Error 5002, {Param Range is not numeric: } & x
End ForAll
 
If Sheet Is Nothyng Then Error 5003, {Param Sheet is nothyng}
Call Sheet.getCellByPosition(xy(0), xy(1)).setString(Value)
Exit sub
ERRLINE:
Print "SetValue - Code: " & CStr(Err) & " Text: " & Error$ & " Line: " & CStr(Erl)
pLastError = Error$
pLastErrorLine = Erl
pLastErrorCode = Err
Resume Next
End Sub
 
Select Range
Public Sub SetRange(Pos)
On Error Resume Next
fPos = Split(Pos, ":")
Set RangeObj = Sheet.getCellRangeByPosition(fPos(0), fPos(1), fPos(2), fPos(3))
End Sub
 
Border Line
Public Function CellBorderLine(nColor, nInnerLineWidth, nOuterLineWidth, nLineDistance) As Variant
On Error GoTo ERRLINE
Dim oSM As Variant
Dim oBorderLine As Variant
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 CellBorderLine = oBorderLine
 
ERRLINE:
Print "CellBorderLine - Code: " & CStr(Err) & " Text: " & Error$ & " Line: " & CStr(Erl)
pLastError = Error$
pLastErrorLine = Erl
pLastErrorCode = Err
Resume Next
End Function
 
All Border Make
Public Sub Border(nColor, nInnerLineWidth, nOuterLineWidth, nLineDistance)
Set RangeObj.TopBorder      = CellBorderLine(nColor, nInnerLineWidth, nOuterLineWidth, nLineDistance)
Set RangeObj.RightBorder    = CellBorderLine(nColor, nInnerLineWidth, nOuterLineWidth, nLineDistance)
Set RangeObj.LeftBorder     = CellBorderLine(nColor, nInnerLineWidth, nOuterLineWidth, nLineDistance)
Set RangeObj.BottomBorder   = CellBorderLine(nColor, nInnerLineWidth, nOuterLineWidth, nLineDistance)
End Sub
 
Private Function MakePropertyValue(cName, uValue) As Variant
On Error GoTo ERRLINE
Dim oPropertyValue As Variant
Dim oSM As Variant
Dim Res(1) As String
 
Set oPropertyValue = ObjServiceManager.Bridge_GetStruct("com.sun.star.beans.PropertyValue")
oPropertyValue.Name = cName
oPropertyValue.Value = uValue
Set MakePropertyValue = oPropertyValue
Res(0) = "1"
Res(1) = ""
EXT_:
MakePropertyValue = Res
Exit Function
ERRLINE:
Res(0) = "0"
Res(1) = "MakePropertyValue - Code: " & CStr(Err) & " Text: " & Error$ & " Line: " & CStr(Erl)
Print Res(1)
pLastError = Error$
pLastErrorLine = Erl
pLastErrorCode = Err
Resume EXT_
End Function
End Class