How can I use a macro in Basic to copy formatted text data from spreadsheet to a text document?

[ThomasBourchier]

Hi,

I have a spreadsheet (ods file) in which I have been storing textual data. I want to automate the copying of each cell out to a document file (odt file). However within each cell of the spreadsheet, I have set a mix of textual attributes, i.e. some text is standard font, some characters are in italics, some in bold.

I have tried creating a macro that employs the the getString method and it successfully copies the text data into my odt file, but all the careful text formatting has been lost. Is there a more obscure method I can use, maybe by using createTextCursor etc. that might do the job for me?

Sorry but I am only on day one of trying out macros and Basic and I am feeling a bit confused! The code I have been trying is below:

Sub MyDoLoop
 
Dim ColNo as Integer
Dim Cursor as Object
Dim Doc As Object
Dim Dummy()
Dim oCell as Object
Dim oSheet as Variant
Dim oSheets as Variant
Dim oString as String
Dim RowNo as Integer
Dim Url As String

oSheets = ThisComponent.getSheets(0)
oSheet = oSheets.getByIndex(0)

Url = "private:factory/swriter"
Doc = StarDesktop.loadComponentFromURL(Url, "_blank", 0, Dummy())
Cursor = Doc.Text.createTextCursor

For RowNo = 1 To 5
	oString = "" 
	For ColNo = 1 To 4
		oCell = oSheet.GetCellByPosition(ColNo, RowNo)
		oString = oString + oCell.getString()
		If ColNo < 3 then oString = oString + ", " 
		if ColNo = 3 then oString = oString + " "
		Next
	Cursor.String = oString
	Doc.Text.insertControlCharacter(Cursor, _
		com.sun.star.text.ControlCharacter.LINE_BREAK, False)
	Cursor.gotoEnd(False)
	Next

Url = "file:///C:/Gash/data.odt"
Doc.storeAsURL(Url, Dummy())

End Sub

[qubit1]

@JohnSUN – Any suggestions here?

[doug]

By invoking MsgBox oCell.dbg_properties and MsgBox Cursor.dbg_properties it is possible to see the available formatting values to transfer between the two documents, which are documented here.

In short, you pick the format you want to transfer and set the cursor's property to equal same property as the cell. Then you move the cursor along. This functionality requires re-writing the macro a bit mostly to get more granular writes to the cursor. This assumes the whole cell is formatted the same way. There are other formats as well, especially for asian language fonts, and this does not take into account styles.

REM  *****  BASIC  *****
Sub MyDoLoop

Dim ColNo as Integer, Cursor as Object, Doc As Object, Dummy()
Dim oCell as Object, oSheet as Variant, oSheets as Variant, oString as String
Dim RowNo as Integer, Url As String

oSheets = ThisComponent.getSheets(0)
oSheet = oSheets.getByIndex(0)

Url = "private:factory/swriter"
Doc = StarDesktop.loadComponentFromURL(Url, "_blank", 0, Dummy())
Cursor = Doc.Text.createTextCursor
defaultFont = Cursor.CharFontName

For RowNo = 1 To 5
    oString = "" 
    For ColNo = 1 To 4
        oCell = oSheet.GetCellByPosition(ColNo, RowNo)
        oString = oCell.getString()
        Cursor.String = oString
        Cursor.CharWeight = oCell.CharWeight
        Cursor.CharStrikeout = oCell.CharStrikeout
        Cursor.CharUnderline = oCell.CharUnderline
        Cursor.CharHeight = oCell.CharHeight
        Cursor.CharPosture = oCell.CharPosture
        Cursor.CharColor = oCell.CharColor
        Cursor.CharFontFamily = oCell.CharFontFamily
        Cursor.CharShadowed = oCell.CharShadowed
        Cursor.CharContoured = oCell.CharContoured
        Cursor.CharRelief = oCell.CharRelief
        Cursor.CharFontName = oCell.CharFontName
        Cursor.gotoEnd(False)
        
        Cursor.CharWeight = 100
        Cursor.CharUnderline = 0
        Cursor.CharHeight = 10
        Cursor.CharStrikeout = 0
        Cursor.CharPosture = 0
        Cursor.CharColor = 0
        Cursor.CharFontFamily = 5
        Cursor.CharShadowed = 0
        Cursor.CharRelief = 0
        Cursor.CharContoured = 0
        Cursor.CharFontName = defaultFont
 
        If ColNo < 3 then oString = ", " 
        if ColNo = 3 then oString = " "
        Cursor.String = oString
        Cursor.gotoEnd(False)
        Next
    Doc.Text.insertControlCharacter(Cursor, _
        com.sun.star.text.ControlCharacter.LINE_BREAK, False)
    Cursor.gotoEnd(False)
    Next
Url = "file:/home/user/outfile.odt"
Doc.storeAsURL(Url, Dummy())

End Sub

[erAck]

Note that Url = "file:/home/user/outfile.odt" lacks two slashes to be a valid URI (it might work without though, didn’t try), it should be

Url = "file:///home/user/outfile.odt"

[Xavier]

I am wanting to do a similar thing: I have an ods sheet with two columns and N cells, each of them with a text including (within the same cell) different colors, bold or not etc… and I want to copy the exact content of each cell in a single rtf file (thus generating N files).

My approach is to parse the ods file, for each cell found, copy it, open writer, paste special the cell then save the writer doc as rtf and close it.

BUT I can not get the correct command to force the paste special to be “Formatted text”, each time writer asks me whether I want calc8, HTML, etc…

It is very frustrating because the output (with the manual “Formatted text” choice) is absolutely perfect!

Any help?