+ Rispondi al Thread
Visualizzazione dei risultati da 1 a 4 su 4

Discussione: OpenOffice Calc: formattare da programma parte del contenuto di una cella

  1. #1
    L'avatar di Brontolo
    Brontolo non è in linea Very Important Person
    Post
    2,630

    OpenOffice Calc: formattare da programma parte del contenuto di una cella

    Buongiorno.
    Mi capita spesso di dover creare delle funzioni di esportazione di dati verso fogli Excel, partendo da griglie gestite da programmi Visual Basic. Ora ho la necessità di fare la stessa cosa verso OpenOffice Calc e, documentandomi, ci sono riuscito tranne che per la formattazione (stile e colore del testo) di sottostringhe del contenuto delle celle.
    Sottolineo che non mi interessa farlo mediante macro, bensì con le funzioni dell'API di OpenOffice.
    Qualcuno mi può dare un'indicazione?
    Grazie.
    Il regolamento del forum: la prima cosa da leggere.

  2. #2
    L'avatar di Max.Riservo
    Max.Riservo non è in linea Scolaretto
    Post
    461
    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.
    codice:
    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

  3. #3
    L'avatar di Brontolo
    Brontolo non è in linea Very Important Person
    Post
    2,630
    Ciao Max e grazie.
    Quello che sto cercando di fare è applicare una diversa formattazione (charColor, charWeight) solo ad una parte del testo contenuto in una cella.
    In ogni caso esaminerò con attenzione e farò tesoro delle funzioni che mi hai postato.
    Grazie ancora.
    Il regolamento del forum: la prima cosa da leggere.

  4. #4
    L'avatar di Brontolo
    Brontolo non è in linea Very Important Person
    Post
    2,630
    Ho trovato una soluzione, anche se probabilmente ne esistono di migliori.
    codice:
                        Set oCell = oSheet.getCellByPosition(iC, iR)
                        Set oText = oCell.GetText
                        Set oCursor = oCell.createTextCursor()
                        oCursor.CharColor = RGB(0, 0, 0)
                        oText.insertString oCursor, "testo nero", False
                        oCursor.CharColor = RGB(0, 0, 255)
                        oText.insertString oCursor, "testo rosso", False
                        oCursor.CharColor = RGB(0, 0, 0)
    Tutte le variabili che iniziano con "o" sono di tipo Object. Si noti che:
    1) Le coordinate della cella sono invertite rispetto a quelle di una cella di una FlexGrid
    2) Impostando il colore con la funzione RGB() si ottengono risultati incomprensibili. I valori per il rosso sono stati ottenuti empiricamente; RGB(0,0,255) dovrebbe essere blu.
    Il regolamento del forum: la prima cosa da leggere.

+ Rispondi al Thread

Permessi di invio

  • Non puoi inserire discussioni
  • Non puoi inserire repliche
  • Non puoi inserire allegati
  • Non puoi modificare i tuoi messaggi