I have edited this post on 28-Jan-2009
The below given code is updated with the new changes
Here is the new method to transfer xBrowse Data to OpenOffice Calc (Equivalent to MS Excel).
This code is in a very preliminary stage, but definitely it transfers data from xBrowse to OpenOffice Calc.
Anybody here interested in this piece of code can modify and add more functionalities and share it here. It is even possible to transfer xBrowse data to PDF format by adding a new parameter and few lines of code to this method. Will be useful for clients who wants to use OpenSource and there by reduce the cost on MS Office.
ToCalc() can Export xBrowse Data to PDF,MS Excel and HTML formats as of now
Compared to the Method ToExcel(), the following are the limitations as of now
1) Group totals not implemented. (Implemented Now)
2) Another drawback is that OpenOffice Calc is showing a dialog while pasting data from clipboard to calc. User has to click on the OK button of that Dialog to proceed with the data transfer. As of now I don't know how to avoid that dialog but definitlely there will be an option to bypass this. ( I have implemeted 2 different ways for transfering Data from XBrowse to OpenOffice Calc. User now have the option to choose the which method to be used for the transfer. Method 2 is the default, but method 1 is found to be much faster, but this method will bring a popup dialog as I said)
3) Date format technique needs to be modified. ( Done )
4 Multi Language support added
Please add the following code to your xBrowse.Prg
Method ToCalc(bProgress, nGroupBy, nPasteMode, aSaveAs)
- Code: Select all Expand view RUN
//----------------------------------------------------------------------------//
METHOD ToCalc( bProgress, nGroupBy, nPasteMode, aSaveAs ) CLASS TXBrowse
local oCalc, oDeskTop,oBook, oSheet, oWin, oLocal, oDispatcher
local nCol, nXCol, oCol, cType, uValue
local uBookMark, nRow
local nDataRows
local aCols
local oClip, cText, nPasteRow, nStep, cFormat,cFileName,cURL,i
local aTotals := {}, lAnyTotals := .f. , aProp:={} , aOOFilters:={} , nPos, oCharLocale
DEFAULT nPasteMode:=1
DEFAULT aSaveAs:={}
aOOFilters:={ {"PDF","calc_pdf_Export"},{"XLS","MS Excel 97"},{"HTML","XHTML Calc File"} }
nDataRows := EVAL( ::bKeyCount )
if nDataRows == 0
return nil
endif
aCols := ::GetVisibleCols()
if Empty( aCols )
return nil
endif
#ifdef __XHARBOUR__
TRY
oCalc := GetActiveObject( "com.sun.star.ServiceManager" )
CATCH
TRY
oCalc := CreateObject( "com.sun.star.ServiceManager" )
CATCH
MsgAlert( "Open Office Calc not installed" )
return Self
END
END
#else
oCalc := TOLEAuto():New( "com.sun.star.ServiceManager" )
#endif
lxlEnglish:=.T.
oDesktop := oCalc:CreateInstance( "com.sun.star.frame.Desktop" )
// Create OpenOffice Calc Instance with the Window Hidden Property
aProp:={}
AAdd(aProp,GetPropertyValue(oCalc, "Hidden", .T. ) )
oBook := oDesktop:LoadComponentFromURL( "private:factory/scalc", "_blank", 0, aProp )
oSheet := oBook:GetSheets():GetByIndex( 0 )
oDispatcher:= oCalc:CreateInstance( "com.sun.star.frame.DispatchHelper" )
// Object to handle OpenOffice Language
oCharLocale = oBook:GetPropertyValue("CharLocale")
IF oCharLocale:Language == "de" // German
cxlSum:="=SUMME("
ELSEIF oCharLocale:Language == "fr" // French
cxlSum:="=SOMME("
ELSEIF oCharLocale:Language == "es" // Spanish
cxlSum:="=SUMA("
ELSEIF oCharLocale:Language == "pt" // Portugese
cxlSum:="=SOMA("
ELSEIF oCharLocale:Language == "it" // Italian
cxlSum:="=SOMMA("
ELSE
cxlSum:="=SUM("
ENDIF
// This routine blocks screen updating and therefore allows faster macro execution
oBook:addActionLock()
oBook:LockControllers()
uBookMark := EVAL( ::bBookMark )
nRow := 1
nCol := 0
for nXCol := 1 TO Len( aCols )
oCol := aCols[ nXCol ]
nCol ++
oSheet:GetCellByPosition( nCol-1, nRow-1 ):SetString = oCol:cHeader
cType := oCol:cDataType
DO CASE
CASE cType == 'N'
cFormat := If( lThouSep, If( lxlEnglish, "#,##0", "#.##0" ), "0" )
if oCol:cEditPicture != nil .AND. "." $ oCol:cEditPicture
cFormat += If( lxlEnglish, ".00", ",00" )
endif
oSheet:GetColumns():GetByIndex( nCol-1 ):NumberFormat:=GetNumberFormatId(oBook, cFormat, cType)
oSheet:GetColumns():GetByIndex( nCol-1 ):HoriJustify = 3 // 3 Right Alignement
CASE cType == 'D'
if lxlEnglish
if ValType( oCol:cEditPicture ) == 'C' .and. !( oCol:cEditPicture = '@' )
oSheet:GetColumns():GetByIndex( nCol-1 ):NumberFormat:=GetNumberFormatId(oBook, oCol:cEditPicture, oCol:cHeader, cType )
else
oSheet:GetColumns():GetByIndex( nCol-1 ):NumberFormat:=GetNumberFormatId(oBook, Set( _SET_DATEFORMAT ), oCol:cHeader, cType )
endif
oSheet:GetColumns():GetByIndex( nCol-1 ):HoriJustify = 3 // 3 Right Alignment
endif
CASE cType == 'L'
// leave as general format
OTHERWISE
oSheet:GetColumns():GetByIndex( nCol-1 ):NumberFormat:= "@"
ENDCASE
Next nXCol
oBook:CurrentController:select( oSheet:GetCellRangeByPosition( 0, 0, Len( aCols )-1,0 ) )
oSheet:getCellByPosition(0,0):Rows:Height=750 //1000 = 1cm
// Draw Bottom Border Line on the Header Row
aProp:={}
AAdd(aProp,GetPropertyValue(oCalc, "OuterBorder.BottomBorder", {0,0,2,0} ) )
oDispatcher:ExecuteDispatch(oBook:GetCurrentController():GetFrame(), ".uno:SetBorderStyle", "", 0, aProp)
// Make Header Row Font Bold
aProp:={}
AAdd(aProp,GetPropertyValue(oCalc, "Bold", .T. ) )
oDispatcher:ExecuteDispatch(oBook:GetCurrentController():GetFrame(), ".uno:Bold", "", 0, aProp)
// Make Setting for Paste Tab Delimited Text
aProp:={}
AAdd(aProp,GetPropertyValue(oCalc, "FilterName", "Text" ) )
AAdd(aProp,GetPropertyValue(oCalc, "FilterOptions", "9,,MS_1257,0,2/2/2/2/2/2/2/2/2/2/2/2/2/2/2/2" ) )
if Empty( ::aSelected ) .or. Len( ::aSelected ) == 1
Eval( ::bGoTop )
if ::oRs != nil .AND. Len( aCols ) == ::oRs:Fields:Count()
::oRs:MoveFirst()
nRow := oSheet:GetCellByPosition( 2, 1 ):CopyFromRecordSet( ::oRs )
::oRs:MoveFirst()
nRow += 2
else
if bProgress == nil
if ::oWnd:oMsgBar == nil
bProgress := { || nil }
else
bProgress := { | n, t | ::oWnd:SetMsg( "To Calc : " + Ltrim( Str( n ) ) + "/" + Ltrim( Str( t ) ) ) }
endif
endif
nRow := 2
nPasteRow := 2
nStep := Max( 1, Min( 100, Int( nDataRows / 100 ) ) )
cText := ""
oClip := TClipBoard():New()
if oClip:Open()
Eval( bProgress, 0, nDataRows )
do while nRow <= ( nDataRows + 1 )
if ! Empty( cText )
cText += CRLF
endif
cText += ::ClpRow( .t. )
::Skip( 1 ) // Eval( ::bSkip, 1 )
nRow ++
if Len( cText ) > 16000
oClip:SetText( cText )
oBook:CurrentController:select( oSheet:GetCellByPosition( 0,nPasteRow-1 ) )
IF nPasteMode == 2
oDispatcher:ExecuteDispatch(oBook:GetCurrentController():GetFrame(), ".uno:Paste", "", 0, aProp)
else
PasteUnformattedText(oCalc,oBook,oSheet,aCols)
Endif
oClip:Clear()
cText := ""
nPasteRow := nRow
endif
If ( nRow - 2 ) % nStep == 0
if Eval( bProgress, nRow - 2, nDataRows ) == .f.
Exit
endif
SysRefresh()
endif
enddo
if ! Empty( cText )
oClip:SetText( cText )
oBook:CurrentController:select( oSheet:GetCellByPosition( 0,nPasteRow-1 ) )
IF nPasteMode == 2
oDispatcher:ExecuteDispatch(oBook:GetCurrentController():GetFrame(), ".uno:Paste", "", 0, aProp)
else
PasteUnformattedText(oCalc,oBook,oSheet,aCols)
Endif
oClip:Clear()
cText := ""
endif
oClip:Close()
Eval( bProgress, nDataRows, nDataRows )
SysRefresh()
endif
oClip:End()
endif
else
::Copy()
oBook:CurrentController:select( oSheet:GetCellByPosition( 2,1 ) )
IF nPasteMode == 2
oDispatcher:ExecuteDispatch(oBook:GetCurrentController():GetFrame(), ".uno:Paste", "", 0, aProp)
else
PasteUnformattedText(oCalc,oBook,oSheet,aCols)
Endif
nRow := Len( ::aSelected ) + 2
ENDIF
nCol := 0 ; nRow:=nRow-2
oBook:CurrentController:select( oSheet:GetCellRangeByPosition( 0, nRow, Len( aCols )-1,nRow ) )
// Draw Bottom Border Line on the Bottom Row
aProp:={}
AAdd(aProp,GetPropertyValue(oCalc, "OuterBorder.BottomBorder", {1,1,2,1} ) )
oDispatcher:ExecuteDispatch(oBook:GetCurrentController():GetFrame(), ".uno:SetBorderStyle", "", 0, aProp)
if ValType( nGroupBy ) == 'N'
for nxCol := 1 TO Len( aCols )
if aCols[ nxCol ]:lTotal
AAdd( aTotals, nxCol )
endif
next
if ! Empty( aTotals )
CalcSubTotal(oCalc,oBook,oSheet,nGroupBy,aTotals,nRow,Len(aCols)-1)
Endif
else
// If lTotal is .T. for any column then create the formula to Show the Column Total
for nXCol := 1 TO Len ( aCols )
oCol := aCols[ nXCol ]
nCol ++
if oCol:lTotal
oBook:CurrentController:select( oSheet:GetCellByPosition( nCol-1,nRow+1 ) )
aProp:={}
*AAdd(aProp,GetPropertyValue(oCalc, "StringName","=SUM("+ oSheet:getColumns():getByIndex(nCol)+"2:"+oSheet:getColumns():getByIndex(nCol)+LTrim(Str(nRow+1))+")" ) )
AAdd(aProp,GetPropertyValue(oCalc, "StringName",cxlSum+ MakeColAlphabet(nCol)+"2:"+MakeColAlphabet(nCol)+LTrim(Str(nRow+1))+")" ) )
oDispatcher:ExecuteDispatch(oBook:GetCurrentController():GetFrame(), ".uno:EnterString", "", 0, aProp)
lAnyTotals := .t.
endif
next nXCol
if lAnyTotals
oBook:CurrentController:select( oSheet:GetCellRangeByPosition( 0, nRow+1, Len( aCols )-1,nRow+1 ) )
// Draw Bottom Border Line on the Total Line Row
aProp:={}
AAdd(aProp,GetPropertyValue(oCalc, "OuterBorder.BottomBorder", {1,1,2,1} ) )
oDispatcher:ExecuteDispatch(oBook:GetCurrentController():GetFrame(), ".uno:SetBorderStyle", "", 0, aProp)
// Make the Total Line Bold
aProp:={}
AAdd(aProp,GetPropertyValue(oCalc, "Bold", .T. ) )
oDispatcher:ExecuteDispatch(oBook:GetCurrentController():GetFrame(), ".uno:Bold", "", 0, aProp)
ENDIF
Endif
oBook:CurrentController:select( oSheet:GetCellByPosition( 1,1 ) )
for nCol := 1 to Len( aCols )
oSheet:GetColumns():GetByIndex( nCol-1 ):OptimalWidth = .T.
next
oBook:CurrentController:select( oSheet:GetCellByPosition( 0,1 ) )
oDispatcher:ExecuteDispatch(oBook:GetCurrentController():GetFrame(), ".uno:FreezePanes", "", 0, {})
Eval( ::bBookMark, uBookMark )
::Refresh()
::SetFocus()
// This routine allows screen updating
oBook:UnlockControllers()
oBook:removeActionLock()
// If you want to convert this to other formats like PDF format or MS Excel
IF Len(aSaveAs) > 0
FOR I:=1 TO Len(aSaveAs)
cFormat:=Upper(aSaveAs[i][1])
cFileName:=aSaveAs[i][2]
* Ensure leading slash.
IF LEFT( cFilename, 1 ) != "/"
cFileName:= "/" + cFileName
ENDIF
cURL:= StrTran( cFilename, "\", "/" ) // change backslashes to forward slashes.
cURL = "file://" + cURL
aProp:={} ; nPos:=0
nPos:=AScan(aOOFilters,{ |x| x[1] == cFormat})
IF nPos > 0
AAdd(aProp,GetPropertyValue(oCalc, "FilterName", aOOFilters[nPos][2]) )
cURL:=cURL+"."+cFormat
oBook:StoreToURL( cURL, aProp )
Endif
Next
ENDIF
oBook:GetCurrentController():GetFrame():GetContainerWindow():SetVisible(.T.)
oBook:CurrentController:select( oSheet:GetCellByPosition( 0,0 ) )
* oBook:Close(1) // To Close OpenOffice Calc
Return Self
//----------------------------------------------------------------------------//
STATIC Function MakeColAlphabet(nCol)
LOCAL aColumns:={"A","B","C","D","E","F","G","H","I","J","K","L","M","N","O","P","Q","R",;
"S","T","U","V","W","X","Y","Z"}
LOCAL cColAphabet,nInt
IF nCol <= 26
cColAphabet:=aColumns[nCol]
ELSEif nCol <= 676
nInt:=Int(nCol/26)
cColAphabet:=aColumns[nCol]
cColAphabet+=aColumns[nCol-(nInt*26)]
Endif
RETURN cColAphabet
//----------------------------------------------------------------------------//
STATIC FUNCTION GetPropertyValue(oService, cName, xValue )
LOCAL oArg
oArg := oService:Bridge_GetStruct( "com.sun.star.beans.PropertyValue" )
oArg:Name := cName
oArg:Value := xValue
RETURN oArg
//----------------------------------------------------------------------------//
STATIC Function GetNumberFormatId(oBook, cNumberFormat, cColHeader, cDataType)
LOCAL cCharLocale,nFormatId
cCharLocale = oBook:GetPropertyValue("CharLocale")
IF cDataType == "D" // Date
cNumberFormat:=Upper(cNumberFormat)
IF cCharLocale:Language == "es" .or. cCharLocale:Language == "pt" .or. cCharLocale:Language == "it" // Spanish,Portuguese,Italian,French
cNumberFormat:=StrTran(cNumberFormat,"Y","A") // All Y should be replaced to A
ELSEIF cCharLocale:Language == "de" // German
cNumberFormat:=StrTran(cNumberFormat,"D","T") // All D should be replaced to T
cNumberFormat:=StrTran(cNumberFormat,"Y","J") // All Y should be replaced to J
elseif cCharLocale:Language == "fr" // French
cNumberFormat:=StrTran(cNumberFormat,"D","J") // All D should be replaced to J
cNumberFormat:=StrTran(cNumberFormat,"Y","A") // All Y should be replaced to A
Endif
Endif
nFormatId = oBook:GetNumberFormats:QueryKey(cNumberFormat, cCharLocale, .F.)
IF nFormatId = -1 // 'Format is not yet defined
TRY
nFormatId = oBook:GetNumberFormats:AddNew(cNumberFormat, cCharLocale)
CATCH
MsgInfo("Could not set the format "+cNumberFormat+" to column "+cColHeader)
IF cDataType == "D" // Date
nFormatId:=37
Endif
END
ENDIF
RETURN nFormatId
//----------------------------------------------------------------------------//
STATIC FUNCTION CalcSubTotal(oCalc,oBook,oSheet,nGroupBy,aTotals,nRow,nCol)
LOCAL oRange, oSubTotDesc,oColumns,aArg:={},nCount
FOR nCount:=1 TO Len(aTotals)
oColumns := oCalc:Bridge_GetStruct( "com.sun.star.sheet.SubTotalColumn" )
//Description by columns : sum of 4th col should be 3, for 2 it should be 1
oColumns:Column := aTotals[nCount]-1
oColumns:Function :=2 // com.sun.star.sheet.GeneralFunction.SUM
AAdd(aArg,oColumns)
Next
oRange:= oSheet:getCellRangeByPosition( 0, 0, nCol,nRow )
oSubTotDesc:=oRange:createSubTotalDescriptor(.T.) // true creates an empty descriptor. false previous settings
//Group by: nGroupBy col-1
oSubTotDesc:addNew(aArg, nGroupBy-1)
oRange:applySubTotals(oSubTotDesc, .T.) // true = replaces previous subtotal
Return NIL
//----------------------------------------------------------------------------//
STATIC Function PasteUnformattedText(oCalc,oBook,oSheet,aCols)
LOCAL oClipContType,oClipContent,oClip,cStr,i,nClipColNo
LOCAL lFound,nRow,nCol,k,oCol
oClip = oCalc:CreateInstance("com.sun.star.datatransfer.clipboard.SystemClipboard")
oClipContType = oClip:Contents:getTransferDataFlavors
lFound = .F. ; i:= 1
DO while i <= Len(oClipContType) .AND. !lFound
if oClipContType[i]:HumanPresentableName = "OEM/ANSI Text"
lFound = .T.
k:=i
else
i:=i + 1
endif
Enddo
if lFound
nRow = oBook:CurrentSelection:getRangeAddress():startrow
oClipContent:=oClip:Contents:getTransferData( oClipContType[k] )
i:=1 ; cStr:="" ; nCol:=0
DO while i <= Len(oClipContent)
if oClipContent[i] = 0 .OR. oClipContent[i] = 13 .OR. oClipContent[i] = 10
i=i+2 ; nRow:=nRow + 1 ; cStr:="" ; nCol:=0
ELSEIF oClipContent[i] = 9 // Tab
oCol:=aCols[nCol+1]
IF oCol:cDataType == "C"
oSheet:getCellByposition(nCol,nRow):SetString(cStr)
ELSEIF oCol:cDataType == "N"
oSheet:getCellByposition(nCol,nRow):SetValue(cStr)
ELSEIF oCol:cDataType == "D"
oSheet:getCellByposition(nCol,nRow):SetFormula(cStr)
ELSE
oSheet:getCellByposition(nCol,nRow):SetString(cStr)
Endif
nCol:=nCol+1 ; cStr:="" ; i:=i+1
else
cStr:=cStr + chr(oClipContent[i])
i:=i+1
endif
Enddo
endif
RETURN NIL
//----------------------------------------------------------------------------//
Regards
Anser
