Ask Your Question
1

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

asked 2013-02-18 17:13:03 +0100

ThomasBourchier gravatar image

updated 2014-07-25 23:02:26 +0100

bencomp gravatar image

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 flag offensive 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

Comments

@JohnSUN -- Any suggestions here?

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

2 Answers

Sort by » oldest newest most voted
1

answered 2015-07-21 07:45:49 +0100

doug gravatar image

updated 2015-07-21 07:57:36 +0100

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
edit flag offensive delete link more

Comments

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"
erAck gravatar imageerAck ( 2018-03-26 14:39:27 +0100 )edit
0

answered 2018-03-25 13:21:03 +0100

this post is marked as community wiki

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?

edit flag offensive delete link more

Question Tools

Stats

Asked: 2013-02-18 17:13:03 +0100

Seen: 1,764 times

Last updated: Mar 25 '18