Alaska Software Inc. - CHR(i) to Excel
Username: Password:
AuthorTopic: CHR(i) to Excel
AUGE_OHRCHR(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_OHRRe: 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
CarlosRe: 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_OHRRe: CHR(i) to Excel
on Sat, 29 Aug 2009 05:18:11 +0200
CarlosRe: 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_OHRRe: 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