В общем, необходимо написать CLASS по работе с OpenOffice(OO) для формирования отчета на стороне сервера, я уже начал писать и написал пока для Win, но хотелось бы сделать его кросс платформенным. В общем нужна Ваша помощь в его написании :lovecodeby:
Вот то что я уже написал
PS сори, за дубликаты, что то какая ошибка вылезла при создании поста
Вот то что я уже написал
Код:
%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 Object's
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 Nothing Then Error 5003, {Param 'Sheet' is nothing}
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 ClassPS сори, за дубликаты, что то какая ошибка вылезла при создании поста
