Ciao, quello che ti allego è il codice di un modulo bas (VB6) sviluppato diverso tempo fa per gestire dei file XLS senza Excel usando OpenOffice (e LibreOffice).
Ora non ho l' ambiente di sviluppo (VB6) disponibile per ricontrollare il tutto ma penso dando un occhio al codice dovresti riuscire a capirlo abbastanza facilmente.
Attribute VB_Name = "Mdg_OO_Utility"
Option Explicit
Public Function Swap_Separator(ByVal vsFileName As String, Optional vsSepIn As String = "\", Optional vsSepOut As String = "/") As String
'
' Scambio di separatore nel nome file (completo di path)
' serve per openoffice
'
Dim aBlk() As String
Dim sSwapFile As String
aBlk = Split(vsFileName, vsSepIn, , vbTextCompare)
sSwapFile = Join(aBlk, vsSepOut)
'
Swap_Separator = sSwapFile
End Function
Public Function Open_OO_Document()
' Get the service manager, as a COM object.
' Everything else about OOo comes directly or indirectly from
' the Service Manager object.
Dim oServiceManager As Object
Set oServiceManager = CreateObject("com.sun.star.ServiceManager")
' Get the Desktop object.
Dim oDesktop As Object
Set oDesktop = oServiceManager.createInstance("com.sun.star.frame.Desktop")
'-----
' A document conversion consists of three steps.
' 1. Open a document.
' If the document is of a format that OOo automatically knows how to open
' then it is not necessary to use a filter.
' If OOo automatically uses a filter you don't want, or if OOo doesn't
' automatically know what filter to use, then you must specify
' which improt filter to use.
' 2. Save document.
' If you want to save the document in OOo's own native document format
' then no export filter is necessary.
' If you want to save in some foriegn document format, then you
' must specify an export filter.
' 3. Close the document.
'-----
'========== Open Document ==========
' Open a document. Use no import filter.
' OOo must be able to automatically recognize what import filter to used).
Dim aNoArgs()
Dim oDoc As Object
' Open an OOo native doucment test.sxw.
Set oDoc = oDesktop.loadComponentFromURL("file:///C:/Test.sxw", "_blank", 0, aNoArgs())
' Open a MS Word document, test.doc.
Set oDoc = oDesktop.loadComponentFromURL("file:///C:/Test.doc", "_blank", 0, aNoArgs())
' Alternative : Open a document using an import filter.
Dim aOpenArgs(0) As Object
' Open an HTML document into Writer.
' (If we had not used this import filter, then OOo would automatically
' open HTML into Web, not Writer.)
Set aOpenArgs(0) = OOoPropertyValue(oServiceManager, "FilterName", "HTML (StarWriter)")
Set oDoc = oDesktop.loadComponentFromURL("file:///C:/Test.html", "_blank", 0, aOpenArgs())
' Open an RTF document into Writer.
Set aOpenArgs(0) = OOoPropertyValue(oServiceManager, "FilterName", "Rich Text Format")
Set oDoc = oDesktop.loadComponentFromURL("file:///C:/Test.rtf", "_blank", 0, aOpenArgs())
'========== Save Document ==========
' Save document in native form. Use no export filter.
Call oDoc.storeToURL("file:///C:/Test.sxw", aNoArgs())
' Alternative : Save document using an export filter.
Dim aSaveArgs(0) As Object
' Save document in MS Word format.
Set aSaveArgs(0) = OOoPropertyValue(oServiceManager, "FilterName", "MS Word 97")
Call oDoc.storeToURL("file:///C:/Test.doc", aSaveArgs())
' Save document in Rich Text Format.
Set aSaveArgs(0) = OOoPropertyValue(oServiceManager, "FilterName", "Rich Text Format")
Call oDoc.storeToURL("file:///C:/Test.rtf", aSaveArgs())
' Save document in PDF.
Set aSaveArgs(0) = OOoPropertyValue(oServiceManager, "FilterName", "writer_pdf_Export")
Call oDoc.storeToURL("file:///C:/Test.pdf", aSaveArgs())
' Save document in HTML.
Set aSaveArgs(0) = OOoPropertyValue(oServiceManager, "FilterName", "HTML (StarWriter)")
Call oDoc.storeToURL("file:///C:/Test.html", aSaveArgs())
'========== Close Document ==========
Call oDoc.Close(True)
End Function
Public Function OOo_Create_Service() As Object
'Creating service manager
Set OOo_Create_Service = CreateObject("com.sun.star.ServiceManager")
End Function
Public Function Open_Xls_File(oServiceManager As Object, sFileName As String, Optional sNew As Boolean = False) As Object
'
' Restituisce un oggetto di tipo Calc
'
'Crea oggeto Desktop ...
Dim oDesktop As Object
Set oDesktop = oServiceManager.createInstance("com.sun.star.frame.Desktop")
' See http://api.openoffice.org/docs/common/ref/com/sun/star/frame/XComponentLoader.html
If sNew Then
' crea doc. nuovo
Dim NoParams()
Set Open_Xls_File = oDesktop.loadComponentFromURL("private:factory/scalc", "_blank", 0, NoParams)
Else
'Imposta parametri per apertura file
Dim OpenParams(0)
Set OpenParams(0) = OOoPropertyValue(oServiceManager, "Hidden", True)
' Set OpenParams(1) = OOoPropertyValue(oServiceManager, "ReadOnly", True)
' apre file esistente
Dim FileName As String
FileName = "file:///"
FileName = FileName & sFileName
Set Open_Xls_File = oDesktop.loadComponentFromURL(FileName, "_blank", 0, OpenParams)
End If
End Function
Public Function Save_Xls_File(oServiceManager As Object, OOoCalc As Object, sFileName As String) As Boolean
Dim aSaveArgs(1)
Set aSaveArgs(0) = OOoPropertyValue(oServiceManager, "FilterName", "MS Excel 97")
Set aSaveArgs(1) = OOoPropertyValue(oServiceManager, "Overwrite", True)
'Save the file
Dim FileName As String
FileName = "file:///"
FileName = FileName & sFileName
Call OOoCalc.storeToURL(FileName, aSaveArgs())
Save_Xls_File = True
End Function
Public Function OOo_Close_File(OOoCalc As Object) As Boolean
'
' chiude file open office
'
Call OOoCalc.Close(True)
OOo_Close_File = True
End Function
Public Function OOo_GetSheet_By_Number(OOoCalc As Object, Optional Sheet_Number As Integer = 0) As Object
' Restituisce un riferimento al foglio di lavoro richiesto
Set OOo_GetSheet_By_Number = OOoCalc.getSheets().getByIndex(Sheet_Number)
End Function
Public Function OOo_GetSheet_By_Name(OOoCalc As Object, Sheet_Name As String) As Object
' Restituisce un riferimento al foglio di lavoro richiesto
Set OOo_GetSheet_By_Name = OOoCalc.getSheets().getByName(Sheet_Name)
End Function
Public Function OOo_RenameSheet_By_Number(OOoCalc As Object, NewName As String, Optional Sheet_Number As Integer = 0) As Boolean
' Rinomina foglio di lavoro partedo dal n°
OOoCalc.getSheets().getByIndex(Sheet_Number).Name = NewName
OOo_RenameSheet_By_Number = True
End Function
Public Function OOo_AddSheet(OOoCalc As Object, NewSheet As String, Optional SheetPos As Integer = -1) As Boolean
Dim OOoSheets As Object
' inserisce un nuovo foglio di lavoro nella posizione richiesta
Set OOoSheets = OOoCalc.Sheets
If SheetPos < 0 Or SheetPos > OOoSheets.GetCount() Then
'inserisce in coda
OOoSheets.InsertNewByName NewSheet, OOoSheets.GetCount()
Else
'inserisce nella posizione richiesta
OOoSheets.InsertNewByName NewSheet, SheetPos
End If
OOo_AddSheet = True
End Function
Public Function OOo_CopySheet(OOoCalc As Object, SourceSheet As String, DestSheet As String, Optional SheetPos As Integer = -1) As Boolean
Dim OOoSheets As Object
' copia un foglio esistente nella posizione posizione richiesta
Set OOoSheets = OOoCalc.Sheets
If SheetPos < 0 Or SheetPos > OOoSheets.GetCount() Then
'inserisce in coda
OOoSheets.copyByName SourceSheet, DestSheet, OOoSheets.GetCount()
Else
'inserisce nella posizione richiesta
OOoSheets.copyByName SourceSheet, DestSheet, SheetPos
End If
OOo_CopySheet = True
End Function
Public Function OOo_DeleteSheet_ByName(OOoCalc As Object, OldSheet As String) As Boolean
Dim OOoSheets As Object
' copia un foglio esistente nella posizione posizione richiesta
Set OOoSheets = OOoCalc.Sheets
OOoSheets.removeByName OldSheet
OOo_DeleteSheet_ByName = True
End Function
Public Function OOo_Cell_Reference(OOoSheet As Object, iCol As Integer, iRow As Integer) As Object
'
' Colonne / Righe : base zero
'
' Restituisce un riferimento ad una cella
Set OOo_Cell_Reference = OOoSheet.getCellByPosition(iCol, iRow)
End Function
Public Function Convert_Excel_Txt(sFileName As String)
'Dim objCoreReflection As Object
'Dim oResult As Object
'Creating service manager
Dim oServiceManager As Object
Set oServiceManager = CreateObject("com.sun.star.ServiceManager")
'Set the parameters for opening the file
Dim OpenParams(1)
Set OpenParams(0) = OOoPropertyValue(oServiceManager, "Hidden", True)
Set OpenParams(1) = OOoPropertyValue(oServiceManager, "ReadOnly", True)
' See http://api.openoffice.org/docs/common/ref/com/sun/star/document/MediaDescriptor.html
'Creating a Desktop to open files
Dim Desktop As Object
Set Desktop = oServiceManager.createInstance("com.sun.star.frame.Desktop")
' See http://api.openoffice.org/docs/common/ref/com/sun/star/frame/XComponentLoader.html
'Open the file
Dim Document1 As Object
Dim FileName As String
FileName = "file:///"
FileName = FileName & sFileName
Set Document1 = Desktop.loadComponentFromURL(FileName, "_blank", 0, OpenParams)
' Restituisce un riferimento al foglio di lavoro richiesto
Dim OOo_GetSheet_By_Number As Object
Set OOo_GetSheet_By_Number = Document1.getSheets().getByIndex(0)
' Restituisce un riferimento ad una cella
Dim OOo_Cell_Reference As Object
Set OOo_Cell_Reference = OOo_GetSheet_By_Number.getCellByPosition(5, 5)
OOo_Cell_Reference.SetValue (4103)
OOo_Cell_Reference.CharHeight = 14 ' Font Size
OOo_Cell_Reference.CharFontName = "Arial" ' Font Name
OOo_Cell_Reference.CharWeight = 2 ' Font Weight
OOo_Cell_Reference.CharColor = RGB(255, 0, 128)
'Setting properties
''Dim SaveParams(2)
''Set SaveParams(0) = OOoPropertyValue(oServiceManager, "FilterName", "Text - txt - csv (StarCalc)") ' Gives comma delimited with ""
''Set aSaveArgs(0) = OOoPropertyValue(oServiceManager, "FilterName", "MS Excel 97")
''Set SaveParams(1) = OOoPropertyValue(oServiceManager, "FilterOptions", "9,,0,1,10")
' See http://api.openoffice.org/docs/DevelopersGuide/Spreadsheet/Spreadsheet.htm#1+2+2+3+Filter+Options
''Set SaveParams(2) = OOoPropertyValue(oServiceManager, "Overwrite", True)
Dim SaveParams(1)
Set SaveParams(0) = OOoPropertyValue(oServiceManager, "FilterName", "MS Excel 97") ' Gives comma delimited with ""
Set SaveParams(1) = OOoPropertyValue(oServiceManager, "Overwrite", True)
'Store the file
Document1.storeToURL "file:///D:/test1.xls", SaveParams
' See http://api.openoffice.org/docs/common/ref/com/sun/star/frame/XStorable.html#storeToURL
'Close Calc
Document1.Close True
End Function
Public Function OOoPropertyValue(oSrvMng As Object, cName, uValue) As Object
'
Dim oPropertyValue As Object
'
Set oPropertyValue = oSrvMng.Bridge_GetStruct("com.sun.star.beans.PropertyValue")
oPropertyValue.Name = cName
oPropertyValue.Value = uValue
'
Set OOoPropertyValue = oPropertyValue
End Function
Public Function Create_Calc_Convert_Excel() As Boolean
Dim oServiceManager As Object
Dim oDesktop As Object
Dim oCalcDoc As Object
Dim oSheet As Object
' Get the Service Manager object -- from whence everything else comes.
' The biggest first difference between programming languages accessing OOo
' is often in how you initially obtain the ServiceManager.
Set oServiceManager = CreateObject("com.sun.star.ServiceManager")
' Get the Desktop object.
Set oDesktop = oServiceManager.createInstance("com.sun.star.frame.Desktop")
' Hide document parameter
Dim aLoadArgs(0)
Set aLoadArgs(0) = oServiceManager.Bridge_GetStruct("com.sun.star.beans.PropertyValue")
aLoadArgs(0).Name = "Hidden"
aLoadArgs(0).Value = True
Set oCalcDoc = oDesktop.loadComponentFromURL("private:factory/scalc", "_blank", 0, aLoadArgs())
' Use this empty array when no arguments are needed : alternative
Dim aNoArgs()
' Create a new empty spreadsheet.
' Set oCalcDoc = oDesktop.loadComponentFromURL("private:factory/scalc", "_blank", 0, aNoArgs())
' Get the first spreadsheet from the bunch of spreadsheets in the document.
Set oSheet = oCalcDoc.getSheets().getByIndex(0)
' Plug in some stuff.
Call oSheet.getCellByPosition(0, 0).setFormula("Month")
Call oSheet.getCellByPosition(1, 0).setFormula("Sales")
Call oSheet.getCellByPosition(0, 1).setFormula("Jan")
Call oSheet.getCellByPosition(0, 2).setFormula("Feb")
Call oSheet.getCellByPosition(0, 3).setFormula("Mar")
Call oSheet.getCellByPosition(1, 1).SetValue(3827)
Call oSheet.getCellByPosition(1, 2).SetValue(3978)
Call oSheet.getCellByPosition(1, 3).SetValue(4103)
Dim oCell As Object
Set oCell = oSheet.getCellByPosition(1, 4)
oCell.setString ("Some text")
' accesso diretto
'Call osheet.getCellByPosition(1, 4).setString("Some text")
' aggiunge colore ...
' First get a cursor
Dim oCursor As Object
Set oCursor = oCell.createTextCursor()
' Now just use oCursor as if it were a word processing document (i.e. Writer).
' Insert some red text.
oCursor.CharColor = RGB(0, 0, 255) ' red
'oCell.insertString ( oCursor, "Hello", True )
oCursor.CharWeight = 150 ' com.sun.star.awt.FontWeight.Bold" ' BOLD is... const float BOLD = 150.000000;
' Italic = 2
' Normal = 100
' Bold = 150
' Set Cell Font Format
oSheet.getCellByPosition(0, 0).CharHeight = 14 ' Font Size
oSheet.getCellByPosition(0, 0).CharFontName = "Arial" ' Font Name
oSheet.getCellByPosition(0, 0).CharWeight = 2 ' Font Weight
oSheet.getCellByPosition(0, 0).CharColor = RGB(255, 0, 128)
oSheet.getCellByPosition(3, 1).setFormula ("=DATE(2004;09;30)")
' Note that these last three dates are not set as DATE() function calls.
oSheet.getCellByPosition(3, 2).setFormula ("10/31/2004")
oSheet.getCellRangeByName("D4").setFormula ("12/31/2004")
' Set column (0) width
Dim oColumns As Object
Dim oColumn As Object
Set oColumns = oSheet.getColumns()
Set oColumn = oColumns.getByIndex(0)
oColumn.Width = 2.5 * 2540
' Save the spreadsheet.
Call oCalcDoc.storeToURL("file:///d:/temp/calcdoc.sxw", aNoArgs())
' Now save it as an Excel file.
Dim aSaveArgs(0)
Set aSaveArgs(0) = oServiceManager.Bridge_GetStruct("com.sun.star.beans.PropertyValue")
aSaveArgs(0).Name = "FilterName"
aSaveArgs(0).Value = "MS Excel 97"
Call oCalcDoc.storeToURL("file:///d:/temp/calcdoc.xls", aSaveArgs())
Call oCalcDoc.Close(True)
End Function
Se non ho capito male la tua richiesta credo che ti serva agire sulla proprietà CharColor
Fai sapere se servono altre info cercherò di risponderti ... anche se in questi giorni sono molto in giro.
Ciao
Rispondi quotando
