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

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

edit retag reopen merge delete

Closed for the following reason the question is answered, right answer was accepted by erAck close date 2018-03-26 14:40:29.075848

@JohnSUN -- Any suggestions here?

( 2013-04-30 07:24:53 +0100 )edit

Sort by » oldest newest most voted

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.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.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

more

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"

( 2018-03-26 14:39:27 +0100 )edit

This post is a wiki. Anyone with karma >75 is welcome to improve it.

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?

more