Author | Topic: CHR(i) to Excel | |
---|---|---|
AUGE_OHR | CHR(i) to Excel on Fri, 28 Aug 2009 07:09:07 +0200 hi, what is wrong with that Code ? please help greetings by OHR Jimmy *** Code *** #PRAGMA LIBRARY( "ASCOM10.LIB" ) PROCEDURE MAIN LOCAL aExcel := {} LOCAL i LOCAL cName LOCAL ZPATH := LEFT( AppName( .t. ), LEN( AppName( .t. ) ) - LEN(AppName( .f. ) ) ) SET CHARSET TO OEM CLS SET ALTER TO CHR2EXCE.TXT SET ALTER ON FOR i := 1 TO 255 ? cName := REPLICATE(CHR(i),10) 10x CHR(i) AADD(aExcel,cName) NEXT SET ALTER OFF SET ALTER TO WAIT ShowExcel(aExcel,ZPATH) RETURN PROCEDURE ShowExcel(aExcel,ZPATH ) LOCAL oExcel LOCAL oWorkBook LOCAL oSheet LOCAL oError LOCAL bSaveError save Errorblock bSaveError := ErrorBlock() set new Errorblock ErrorBlock( {|e| Break(e)} ) BEGIN SEQUENCE Start Excel oExcel := CreateObject( "Excel.Application" ) IF NIL == oExcel Excel.Application could not be created. MSGBOX( "Excel Verbindung konnte nicht erstellt werden" ) BREAK ELSE oExcel:visible := .T. visible If there is a problem, don't let excel pop up messages oExcel:Application:DisplayAlerts := .F. Create a workbook from scratch oExcel:Application:Workbooks:new() oExcel:Application:Workbooks:add() Office 97 Excel creates 3 worksheets by default Delete 2 of them * oExcel:Application:Worksheets(3):delete() * oExcel:Application:Worksheets(2):delete() Make the first one active oWorkBook := oExcel:activeWorkBook oExcel:Application:Worksheets( 1 ):activate() Rename the sheet oExcel:Application:Worksheets( 1 ):name := "ID_USER" Speed things up by creating an object containing the cells oSheet := oExcel:Worksheets( 1 ):cells oSheet:range( "A1:A255" ):value := aExcel Save the workbook If you don't put a path, the file will be somewhere in My Documents or some other Excel default directory oWorkBook:saveas(ZPATH+"TESTI") Quit Excel oExcel:Quit() destroy the reference oExcel:destroy() IF ComLastError() > 0 MSGBOX("Error: "+STR(ComLastError() )+CHR(13)+CHR(10)+"Description:"+ComLastMessage() ) BREAK ENDIF ENDIF RECOVER USING oError restore Errorblock ErrorBlock( bSaveError ) IF ComLastError() > 0 MSGBOX( "Error: " + STR( ComLastError() )+CHR(13)+CHR(10)+"Description:"+ComLastMessage()) ENDIF IF VALTYPE( oExcel ) = 'O' IF VALTYPE( oSheet ) = 'O' oSheet := NIL ENDIF oExcel:Quit() oExcel:Destroy() ENDIF END SEQUENCE restore Errorblock ErrorBlock( bSaveError ) RETURN *** Eof *** | |
AUGE_OHR | Re: CHR(i) to Excel on Fri, 28 Aug 2009 08:43:40 +0200 hi, if i use a 2-Dim Array like AADD(aExcel,{i,cName}) an change to oSheet:range( "A1:B255" ):value := aExcel than it works ... does Excel not like 1-Dim Array ? greetings by OHR Jimmy eusa_doh.gif | |
Carlos | Re: CHR(i) to Excel on Fri, 28 Aug 2009 10:50:56 +0100 Hi Jimmy, It works for 1-Dim if AADD(aExcel,{i}). I'm using a rotine to create xls files in XML format because activex was very slow. It need not Excel instaled but older excel versions can't read it. But your sample shows how speed up things. However to create a XLS file I need know formating too. I changed your sample to this: AADD( aExcel, {"EXCEL TITLE",} ) AADD( aExcel, {,} ) AADD( aExcel, {"COL_1","COL_2"} ) FOR i := 1 TO 205 ? cName := "Line "+LTrim(Str(i)) AADD(aExcel,{cName,i}) NEXT AADD( aExcel, {,"Total"} ) AADD( aExcel, {"Footer",} ) Here are some basic needs: * Put color of text line. * Define a backgound color for a line. Define column width Fornat numeric column (right aligned with thousand separator an 2 decimals) Totalize numeric column Save in old xls format (97/2003) Can you help with a sample or point to some resources? Attcahed is CopyToXls() XML based. Thanks, Carlos "AUGE_OHR" <AUGE_OHR*AT*WEB.DE> escreveu na mensagem news:2732fd20$458e3fa9$3c68a@news.alaska-software.com... > hi, > > if i use a 2-Dim Array like AADD(aExcel,{i,cName}) > an change to oSheet:range( "A1:B255" ):value := aExcel > than it works ... > > does Excel not like 1-Dim Array ? > > greetings by OHR > Jimmy > > copytoxls.prg | |
AUGE_OHR | Re: CHR(i) to Excel on Sat, 29 Aug 2009 05:18:11 +0200 | |
Carlos | Re: CHR(i) to Excel on Tue, 01 Sep 2009 09:27:49 +0100 Hi, Got it. Can you generate this xls file to see if soma (portuguese "sum") is evalueted in your instaled language? Numeric decimal and thousand separators are ok? Many thanks. Carlos #PRAGMA LIBRARY( "ASCOM10.LIB" ) #include "EXCEL.CH" PROCEDURE MAIN LOCAL aExcel := {} LOCAL i, nData LOCAL ZPATH := LEFT( AppName( .t. ), LEN( AppName( .t. ) ) - LEN(AppName( .f. ) ) ) SET CHARSET TO OEM CLS AADD( aExcel, {"TITLE1",,} ) AADD( aExcel, {"Title2",,} ) AADD( aExcel, {"title3",,} ) AADD( aExcel, {,,} ) AADD( aExcel, {"FIELD_C","FIELD_D","FIELD_N"} ) FOR i := 0 TO 9 nData := IIf(i>5,1000,0)+Sqrt(i) ? i, nData AADD( aExcel, {"Data "+LTrim(Str(i)), Date()+i, nData} ) NEXT AADD( aExcel, {,,} ) AADD( aExcel, {"Total....",,"=soma(C6:C15)"} ) =sum() AADD( aExcel, {,,} ) AADD( aExcel, {"Footer",,} ) ShowExcel( aExcel, ZPATH ) RETURN PROCEDURE ShowExcel(aExcel,ZPATH ) LOCAL oExcel LOCAL oWorkBook LOCAL oSheet LOCAL oError LOCAL bSaveError bSaveError := ErrorBlock() ErrorBlock( {|e| Break(e)} ) BEGIN SEQUENCE oExcel := CreateObject( "Excel.Application" ) IF NIL == oExcel MSGBOX( "Excel.Application could not be created." ) BREAK ELSE oExcel:visible := .T. oExcel:Application:DisplayAlerts := .F. oExcel:Application:Workbooks:new() oExcel:Application:Workbooks:add() oExcel:Application:Worksheets(3):delete() oExcel:Application:Worksheets(2):delete() oWorkBook := oExcel:activeWorkBook oExcel:Application:Worksheets( 1 ):activate() oExcel:Application:Worksheets( 1 ):name := "Sheet1" Speed things up by creating an object containing the cells oSheet := oExcel:Worksheets( 1 ):cells oSheet:range( "A1:C19" ):value := aExcel oSheet:Rows( 1 ):Font:size := 16 oSheet:Rows( 1 ):Font:bold := .T. oSheet:Rows( 1 ):Font:color := GraMakeRGBColor( {000,000,255} ) oSheet:Rows( 2 ):Font:size := 10 oSheet:Rows( 2 ):Font:bold := .T. oSheet:Rows( 2 ):Font:color := GraMakeRGBColor( {000,000,255} ) oSheet:Rows( 3 ):Font:size := 10 oSheet:Rows( 3 ):Font:bold := .T. oSheet:Rows( 3 ):Font:color := GraMakeRGBColor( {000,000,255} ) * oSheet:Rows( 5 ):Font:name := "Courier New" * oSheet:Rows( 5 ):Font:size := 20 oSheet:Rows( 5 ):Font:bold := .T. oSheet:Rows( 5 ):Font:color := GraMakeRGBColor( {255,000,128} ) oSheet:Rows( 5 ):Interior:color := GraMakeRGBColor( {255,255,128} ) * oSheet:Rows( 5 ):Interior:pattern:= 10 oSheet:Columns( 1 ):ColumnWidth := 30 oSheet:Columns( 2 ):ColumnWidth := 15 oSheet:Columns( 3 ):ColumnWidth := 15 oSheet:Columns( 3 ):NumberFormatLocal oSheet:Columns( 3 ):NumberFormat := "###.###.##0,00" oSheet:Columns( 2 ):HorizontalAlignment := xlCenter oSheet:Columns( 3 ):HorizontalAlignment := xlRight oSheet:Rows( 19 ):Font():size := 6 oSheet:Rows( 19 ):Font():color := GraMakeRGBColor( {000,000,255} ) oWorkBook:saveas( ZPATH+"TEST", xlWorkbookNormal ) * oExcel:Quit() oExcel:destroy() IF ComLastError() > 0 MSGBOX("Error: "+STR(ComLastError() )+CHR(13)+CHR(10)+"Description:"+ComLastMessage() ) BREAK ENDIF ENDIF RECOVER USING oError ErrorBlock( bSaveError ) IF ComLastError() > 0 MSGBOX( "Error: " + STR( ComLastError() )+CHR(13)+CHR(10)+"Description:"+ComLastMessage()) ENDIF IF VALTYPE( oExcel ) = 'O' IF VALTYPE( oSheet ) = 'O' oSheet := NIL ENDIF oExcel:Quit() oExcel:Destroy() ENDIF ENDSEQUENCE ErrorBlock( bSaveError ) RETURN | |
AUGE_OHR | Re: CHR(i) to Excel on Thu, 03 Sep 2009 11:42:10 +0200 hi, > Can you generate this xls file to see if soma (portuguese "sum") is > evalueted in your instaled language? no "soma" is portugiese and my German need "SUMME" > Numeric decimal and thousand separators are ok? can not say anything while your Array aExcel is wrong > AADD( aExcel, {"FIELD_C","FIELD_D","FIELD_N"} ) you try to work with 3-Dimension ... i do not know how to do it ... you need a 2-Dim Array where each FIELD is 1 Column like XbpBrowse() *** Code *** DBF with 10 Fields #include "EXCEL.CH" for each Field in DBF use a #define #define myARTNR 1 #define myCHINA 2 #define myARTIKEL 3 #define myVERPACK 4 #define myEINH 5 #define myPREIS 6 #define mySTSTUE 7 #define myINHALT 8 #define mySTEINH 9 #define mySTPREIS 10 #define myZeile1 1 #define myZeile2 2 #define myZeile3 3 #define myZeile4 4 #define myZeile5 5 LOCAL aExcel[5][10] Top Header Lines ... nLen := LEN(aExcel) 5 Zeilen FOR i := 1 TO nLen AFILL(aExcel[i],"") Auffllen NEXT aExcel[myZeile1][myCHINA ] := "YIU Gmbh" aExcel[myZeile2][myCHINA ] := "Siemensstr.14" aExcel[myZeile3][myCHINA ] := "21509 Reinbek" aExcel[myZeile4][myARTNR ] := "Tel" aExcel[myZeile5][myARTNR ] := "Fax" aExcel[myZeile4][myCHINA ] := "040-728 7800" aExcel[myZeile5][myCHINA ] := "040-722 7775" ... DbGotop() DO WHILE !EOF() this are Sub-Goups and Sub-Header-line IF cWG == LTRIM(STR(ARTIKEL->WARENGRUPE,3)) ELSE cWG := LTRIM(STR(ARTIKEL->WARENGRUPE,3)) i := ASCAN(aWG,{|x| x[2]== cWG } ) IF i > 0 cName := ConvToAnsiCP(aWG[i][1]) ENDIF "blank" line AADD(aExcel,ARRAY(10)) nLen := LEN(aExcel) AFILL(aExcel[nLen],"") Auffllen new Sub-Group and Sub-Header-line AADD(aExcel,ARRAY(10)) nLen := LEN(aExcel) AFILL(aExcel[nLen],"") Auffllen aExcel[nLen][myARTNR ] := cWG aExcel[nLen][myARTIKEL] := cName add Position to Array for later use AADD(aHeaderLine,nLen) add allway a blank Array AADD(aExcel,ARRAY(10)) nLen := LEN(aExcel) AFILL(aExcel[nLen],"") Auffllen before "fill-up" Description line aExcel[nLen][myARTNR ] := "Artnr" aExcel[nLen][myCHINA ] := "" aExcel[nLen][myARTIKEL] := "Artikel" aExcel[nLen][myVERPACK] := "Verpackung" aExcel[nLen][myEINH ] := "Einh" aExcel[nLen][myPREIS ] := "Preis" aExcel[nLen][mySTSTUE ] := "St.Ein" aExcel[nLen][myINHALT ] := "Inhalt" aExcel[nLen][mySTEINH ] := "St." aExcel[nLen][mySTPREIS] := "Preis" ENDIF add allway a blank Array AADD(aExcel,ARRAY(10)) nLen := LEN(aExcel) AFILL(aExcel[nLen],"") Auffllen before "fill-up" with Data from DBF aExcel[nLen][myARTNR ] := ARTIKEL->ARTNR+" " aExcel[nLen][myCHINA ] := " "+CHINABMP->BILDTEXT *** Eof *** > oExcel:visible := .T. > oExcel:Application:DisplayAlerts := .F. enable DisplayAlerts for Debugging > oSheet:Rows( 1 ):Font:size := 16 > oSheet:Rows( 1 ):Font:bold := .T. > oSheet:Rows( 1 ):Font:color := GraMakeRGBColor( > {000,000,255} ) > oSheet:Rows( 2 ):Font:size := 10 > oSheet:Rows( 2 ):Font:bold := .T. > oSheet:Rows( 2 ):Font:color := GraMakeRGBColor( > {000,000,255} ) > oSheet:Rows( 3 ):Font:size := 10 > oSheet:Rows( 3 ):Font:bold := .T. > oSheet:Rows( 3 ):Font:color := GraMakeRGBColor( > {000,000,255} ) > * oSheet:Rows( 5 ):Font:name := "Courier New" > * oSheet:Rows( 5 ):Font:size := 20 > oSheet:Rows( 5 ):Font:bold := .T. > oSheet:Rows( 5 ):Font:color := GraMakeRGBColor( > {255,000,128} ) > oSheet:Rows( 5 ):Interior:color := GraMakeRGBColor( > {255,255,128} ) > * oSheet:Rows( 5 ):Interior:pattern:= 10 > > > oSheet:Rows( 19 ):Font():size := 6 > oSheet:Rows( 19 ):Font():color := GraMakeRGBColor( > {000,000,255} ) still a lot of "single call" ... try to use *** Code *** Delimiter German is ";" maybe Portuguese is "," (Komma) cRange := "A2:A255"+";"+"B2:B255"+";"+"C2:C255"+";"+"S2:S255" cRange := CHR(34)+cRange+CHR(34) oSheet:Range(&(cRange)):Font:color := GraMakeRGBColor( {000,000,255} ) oSheet:Range(&(cRange)):Font::bold := .T. *** eof **** !!! Note . Xbase++ can only handle RANGE(cRange) for cRange < 256, else you have to "split it" > oWorkBook:saveas( ZPATH+"TEST", xlWorkbookNormal ) for Debugging use MSGBOX("Stop") here before it "disapear" greetings by OHR Jimmy |