¿Cómo enviar a Excel reporte con TPrinter?

[FranciscoA]

Hola amigos del foro. Es eso. Utilizo mucho la clase TPrinter para mis reportes y necesito enviarlos a Excel.
¿Alguno de ustedes puede orientarme, o falicilitarme un pequeño ejemplo?
Gracias.

[Ramon Paredes]

Francisco,

Por que no utilizas Filexls puedes usarla con coordenadas y operaciones matematicas y rompimientos de control y todo lo demas

Saludes

Ramon Paredes

[Ramon Paredes]

Francisco:

Un pequeño ejemplo del uso de filexls


SELECT A
USE RGEN1

PUBLIC oFileXLS,oDlg, oLbx, oFont, oMeter, nMeter,oExcel, oHoja, oBrw

DEFINE FONT oFont NAME "Arial" SIZE 0,-11

PUBLIC lIni := .t., nReg := RecNo(), cActividad := ""

PUBLIC nFormat1, nFormat2,nContar,nContar1
PUBLIC nFont1, nFont2, nFont3, nFont4
nContar = 0
nContar1 = 0

PUBLIC aRowActividad := {}

PUBLIC cSuma1 := "", cSuma2 := "" ,cSuma3 := "", cSuma4 := "",cSuma5 := ""
PUBLIC cSuma6 := "", cSuma7 := "" ,cSuma8 := "", cSuma9 := "",cSuma10 := ""
PUBLIC cSuma11 := "", cSuma12 := "" ,cSuma13 := "", cSuma14 := "",cSuma15 := ""
PUBLIC cSuma16 := ""

PUBLIC nRow, nRowActividad

oExcel := TOleAuto():New( "Excel.Application" )
oHoja := oExcel:Get( "ActiveSheet" )

DEFINE XLS FORMAT nFormat1 PICTURE '#,##0' // para pesetas
DEFINE XLS FORMAT nFormat2 PICTURE '#,##0.00' // para euros

DEFINE XLS FONT nFont1 NAME "Arial" HEIGHT 14 ITALIC BOLD
DEFINE XLS FONT nFont2 NAME "Arial" UNDERLINE
DEFINE XLS FONT nFont3 NAME "Arial Unicode MS" HEIGHT 9
DEFINE XLS FONT nFont4 NAME "Arial Unicode MS" HEIGHT 8


XLS oFileXLS FILE "MAESTRO1.XLS" //AUTOEXEC

XLS COL 1 WIDTH 7 OF oFileXLS
XLS COL 2 WIDTH 25 OF oFileXLS
XLS COL 3 WIDTH 15 OF oFileXLS
XLS COL 4 WIDTH 12 OF oFileXls
XLS COL 5 WIDTH 12 OF oFileXls
XLS COL 6 WIDTH 15 OF oFileXls

nRow := 2
@ nRow,1 XLS SAY "EMPRESA DE SERVICIOS MULTIPLES " FONT nfont1 OF oFileXLS
nRow++
@ nRow,1 XLS SAY "REPORTE GENERAL DE EMPLEADOS ACTIVOS" FONT nfont2 OF oFileXLS
nRow++
@ nRow,1 XLS SAY "CLASIFICADO POR : "+ALLTRIM(xOrden) FONT nfont2 OF oFileXLS
nRow++
@ nRow,1 XLS SAY "Numero" FONT nfont2 OF oFileXLS
@ nRow,2 XLS SAY "Nombres " FONT nfont2 OF oFileXLS
@ nRow,3 XLS SAY "Apellido1" FONT nfont2 OF oFileXLS
@ nRow,4 XLS SAY "Apellido2" FONT nfont2 OF oFileXLS
@ nRow,5 XLS SAY "Fec_Ing" FONT nfont2 OF oFileXLS
@ nRow,6 XLS SAY "Inss" FONT nfont2 OF oFileXLS
nRow += 2
GO TOP
DO WHILE .NOT.EOF()
mUnidad = A->COD_UNI
nRow++
@ nRow,1 XLS SAY "UNIDAD ADMINISTRATIVA : "+A->COD_UNI+"-"+A->NOM_UNI FONT nfont2 OF oFileXLS
nRow++
store 0 to nContar1
DO WHILE mUnidad = A->COD_UNI
nRow++
@ nRow,1 xls say TRIM( A->NUMERO ) FONT nFont4 of oFilexls
@ nRow,2 XLS SAY TRIM( A->NOMBRES) FONT nFont4 of oFilexls
@ nRow,3 XLS SAY TRIM( A->APELLI1) FONT nFont4 of oFilexls
@ nRow,4 XLS SAY TRIM( A->APELLI2) FONT nFont4 of oFilexls
@ nRow,5 XLS SAY TRIM( DTOC(A->FEC_ING)) FONT nFont4 of oFilexls
@ nRow,6 XLS SAY TRIM( A->INSSBI) FONT nFont4 of oFilexls

nContar = nContar + 1
nContar1 = nContar1 + 1

SKIP
ENDDO
nRow++
nRow++
@ nRow,2 XLS SAY "Empleados x Unidad : "+STR(nContar1) FONT nfont3 OF oFileXLS
ENDDO
nRow++
nRow++
@ nRow,1 XLS SAY "Empleados " +STR(nContar) FONT nFont3 OF oFileXLS
nRow++
nRow++

XLS PAGE BREAK AT nRow OF oFileXLS

SET XLS TO DISPLAY ;
NOGRIDLINES ;
OF oFileXLS

SET XLS TO PRINTER ;
TOP MARGIN 0.6 ;
BOTTOM MARGIN 0.8 ;
LEFT MARGIN 0 ;
OF oFileXLS

ENDXLS oFileXLS

oExcel:Visible := .T.
oExcel:WorkBooks:Open(cFilePath(GetModuleFileName(GetInstance()))+"MAESTRO1.XLS")

CLOSE RGEN1

// oHoja:End()
// oExcel:End()

RETURN NIL

[FranciscoA]

Ramón, muchas gracias por responder. En verdad, no se me ha dado por usar filexls, directamente, aunque he leido bastante sobre el particular, en este foro. Actualmente utilizo RepExcel, que funciona satisfactoriamente pero solo con TReport. La idea que tengo es que desde el preview, con TPrinter, enviar el reporte a Excel. Es decir, mantener la opcion estándar de impresión con TPrinter-Preview, y poder elegir desde éste, su exportación a Excel.
Agradezco el ejemplo que me facilitas, lo pruebo y luego te cuento.

Saludos.

[anserkk]

Querido Ramon Paredes,

Es la clase FileXLS OLE depende?. Estoy buscando una clase que puede crear archivos de Excel, incluso si msexcel no está instalado en el PC.

Parece que podemos hacer todo el formato de las columnas como el color, bold, Italics, etc
¿Puedo tener una copia de la clase FileXLS.

Gracias de antemano

Recuerdos

Anser

[Ramon Paredes]

Mi estimado anserkk

Puedes bajar este archivo zip filexls.rar, en el van 3 prg 2 que son complementos de la clase y 1 la clase misma, unicamente tienes que agregarlos en tu proyecto como un prg mas y listo ya puedes usar toda la potencia de esta clase maravillosa, si necesitas ayuda o ejemplos me avisas que estamos para ayudarnos,

El link es :

http://www.megaupload.com/es/?d=2ATXPGVJ

Saludes

Ramon Paredes

[anserkk]

Estimado Ramón Paredes,

Muchas gracias por el enlace de descarga.

El zip contiene 3 PRG del saber

TFileXLS.Prg
XLSError.Prg
XLSFunc.Prg

Por lo que tengo que añadir todas estas 3 del prg a mi proyecto para la CLASS para funcionar correctamente. ¿Tengo razón?

¿Perdiste todo. CH archivos. Cuando he leído el código de ejemplo que envió por encima en este hilo parece que hay una. CH archivo

XLS oFileXLS FILE "MAESTRO1.XLS" / / AUTOEXEC

¿Puede mostrarme una muestra PRG en Oop Sintaxis para, por ejemplo:
oXls: = TFileXls ():New("C:\Prueba.xls")

Una de las principales ventajas es que, esta CLASS no utiliza OLE, Para que MS-Excel no necesita ser instalado en el PC de la CLASS a la obra. Una vez que el archivo. Xls es creado usando esta clase, que se puede abrir a través de OpenOffice Calc.

Una vez más gracias en gran medida de la CLASS

¿Me puede dar una muestra PRG mostrar el uso y la mayoría de las funcionalidades de esta excelente clase.

Saludos

Anser

[Antonio Linares]

Copio aqui el contenido de los ficheros para que no se pierdan

TFileXLS.prg

Code: Select all  Expand view

// FileXLS Library by Ramón Avendaño
// 30-12-99

#include "FiveWin.ch"
#include "Constant.ch"
//#include "XLSError.ch"
#include "FileIO.ch"

//#define _MSLINK_

static nInfo, cInfo := "FileXLS Library" + CRLF + ;
                       "Ramón Avendaño (c) 1999"

// Cell alignament
#define ALING_NULL       0
#define ALING_LEFT       1
#define ALING_CENTER     2
#define ALING_RIGHT      3
#define ALING_FILL       4

// Cell border
#define BORDER_NONE      0
#define BORDER_LEFT      8
#define BORDER_RIGHT    16
#define BORDER_TOP      32
#define BORDER_BOTTOM   64
#define BORDER_ALL     120  // nOR( BORDER_LEFT, BORDER_RIGHT, BORDER_TOP, BORDER_BOTTOM )

// XLS font def
#define XLSFONT_HEIGHT     1
#define XLSFONT_BOLD       2
#define XLSFONT_ITALIC     3
#define XLSFONT_UNDERLINE  4
#define XLSFONT_STRIKEOUT  5
#define XLSFONT_NAME       6

// XLS error code
#define XLSERROR_NULL      0
#define XLSERROR_DIV0      7
#define XLSERROR_VALUE    15
#define XLSERROR_REF      23
#define XLSERROR_NAME     29
#define XLSERROR_NUM      36
#define XLSERROR_N_A      42

EXTERNAL _XLSGenError

#ifdef _MSLINK_
EXTERNAL xlsCELL, xlsSUM, xlsMULT
EXTERNAL xlsABS, xlsINTE, xlsMOD, xlsROUND, xlsSIGN, xlsSQRT, xlsEXP, xlsLN, xlsLOG, ;
         xlsPI, xlsRANDOM, xlsSIN, xlsCOS, xlsTAN, xlsASIN, xlsACOS, xlsATAN
#else
EXTERNAL _CELL, _SUM, _MULT
EXTERNAL _ABS, _INTE, _MOD, _ROUND, _SIGN, _SQRT, _EXP, _LN, _LOG, ;
         _PI, _RANDOM, _SIN, _COS, _TAN, _ASIN, _ACOS, _ATAN
#endif

static aFonts := {}, aFormats := {}

static aOperators := { "", "", "+", "-", "*", "/", "^" }

//----------------------------------------------------------------------------//

CLASS TFileXLS

   DATA   cName
   DATA   hFile

   DATA   oWnd

   DATA   lProtect
   DATA   lAutoexec

   DATA   aHBreaks, aVBreaks

   METHOD New( cFileName, lAutomatic, nIterations,;
               lProtect, lAutoexec, oWnd ) CONSTRUCTOR

   METHOD End()

   //

   METHOD SetDisplay( nTop, nLeft, nBottom, nRight, lHidden, ;
                      lFormulas, lGridLines, lHeaders, lNoZero )

   METHOD SetPrinter( cHeader, cFooter, nLeft, nRight, nTop, nBottom, ;
                      lHeaders, lGredlines )

   //

   METHOD _Row( nRow, nHeight )
   METHOD _Col( nFirstCol, nLastCol, nWidth )

   //

   METHOD Blank( nRow, nCol, ;
                 lHidden, lLocked, nFont, nFormat, lShaded, ;
                 nBorder, nAlignament )

   METHOD Number( nRow, nCol, nNumber, ;
                  lHidden, lLocked, nFont, nFormat, lShaded, ;
                  nBorder, nAlignament )

   METHOD String( nRow, nCol, cString, ;
                  lHidden, lLocked, nFont, nFormat, lShaded, ;
                  nBorder, nAlignament )

   METHOD _Date( nRow, nCol, dDate, ;
                 lHidden, lLocked, nFont, nFormat, lShaded, ;
                 nBorder, nAlignament )

   METHOD Boolean( nRow, nCol, lBoolean, ;
                   lHidden, lLocked, nFont, nFormat, lShaded, ;
                   nBorder, nAlignament )

   METHOD Formula( nRow, nCol, nNumber, lRecalc, cFormula, ;
                   lHidden, lLocked, nFont, nFormat, lShaded, ;
                   nBorder, nAlignament )

   METHOD Say( nRow, nCol, uVal, ;
               lHidden, lLocked, nFont, nFormat, lShaded, ;
               nBorder, nAlignament )

   METHOD Error( nRow, nCol, nError, ;
                 lHidden, lLocked, nFont, nFormat, lShaded, ;
                 nBorder, nAlignament )

   //

   METHOD Note( nRow, nCol, cNote )

   METHOD AddBreak( cCourse, aPos )

   //

   METHOD PutCoors( nRow, nCol )

   METHOD PutAttributes( lHidden, lLocked, nFont, nFormat, lShaded, ;
                         nBorder, nAlignament, nReserved )
   //

   METHOD Info() INLINE MsgInfo( cInfo )

   METHOD Protec() INLINE nInfo := 0, ;
                          AEval( Array( len( cInfo ) ), ;
                          {| a, n | nInfo += Asc( SubStr( cInfo, n, 1 ) ) + n } ), ;
                          nInfo

ENDCLASS

//----------------------------------------------------------------------------//

METHOD New( cFileName, lAutomatic, nIterations,;
            lProtect, lAutoexec, oWnd ) CLASS TFileXLS

   local n, nByte
   local nLen

   if ::Protec() != 4311
      MsgStop( "FileXLS Library" + CRLF + "Copyright violation !" )
      quit
   endif

   DEFAULT cFileName := cTempFile() + ".xls"

   ::cName = cFileName
   ::hFile = FCreate( cFileName, FC_NORMAL )

   ::lProtect  = lProtect
   ::lAutoexec = lAutoexec

   ::oWnd      = oWnd

   ::aHBreaks := {}
   ::aVBreaks := {}

   DEFAULT lAutomatic := .t., nIterations := 0

   FWrite( ::hFile, Chr( 09 ) + Chr( 00 ), 2 )      // BOF
   FWrite( ::hFile, Chr( 04 ) + Chr( 00 ), 2 )
   FWrite( ::hFile, Chr( 05 ) + Chr( 00 ) + Chr( 16 ) + Chr( 00 ), 4 )

   FWrite( ::hFile, Chr( 13 ) + Chr( 00 ), 2 )      // CALCMODE
   FWrite( ::hFile, Chr( 02 ) + Chr( 00 ), 2 )
   FWrite( ::hFile, Chr( if( lAutomatic, 1, 0 ) ) + Chr( 00 ), 2 )

   FWrite( ::hFile, Chr( 12 ) + Chr( 00 ), 2 )      // CALCCOUNT
   FWrite( ::hFile, Chr( 02 ) + Chr( 00 ), 2 )
   FWrite( ::hFile, I2Bin( if( nIterations != 0, nIterations, 1 ) ), 2 )

   FWrite( ::hFile, Chr( 15 ) + Chr( 00 ), 2 )      // REFMODE
   FWrite( ::hFile, Chr( 02 ) + Chr( 00 ), 2 )
   FWrite( ::hFile, Chr( 01 ) + Chr( 00 ), 2 )

   FWrite( ::hFile, Chr( 17 ) + Chr( 00 ), 2 )      // ITERATION
   FWrite( ::hFile, Chr( 02 ) + Chr( 00 ), 2 )
   FWrite( ::hFile, Chr( if( nIterations != 0, 1, 0 ) ) + Chr( 00 ), 2 )

   FWrite( ::hFile, Chr( 16 ) + Chr( 00 ), 2 )      // DELTA
   FWrite( ::hFile, Chr( 08 ) + Chr( 00 ), 2 )      // 0.001
   FWrite( ::hFile, D2Bin( 0.001 ), 8 )

   FWrite( ::hFile, Chr( 14 ) + Chr( 00 ), 2 )      // PRECISION
   FWrite( ::hFile, Chr( 02 ) + Chr( 00 ), 2 )      // full
   FWrite( ::hFile, Chr( 01 ) + Chr( 00 ), 2 )

   FWrite( ::hFile, Chr( 34 ) + Chr( 00 ), 2 )      // 1904
   FWrite( ::hFile, Chr( 02 ) + Chr( 00 ), 2 )      // anything
   FWrite( ::hFile, Chr( 00 ) + Chr( 00 ), 2 )

   FWrite( ::hFile, Chr( 37 ) + Chr( 00 ), 2 )      // DEFAULT ROW HEIGHT
   FWrite( ::hFile, Chr( 02 ) + Chr( 00 ), 2 )      // 33023
   FWrite( ::hFile, I2Bin( 33023 ), 2 )

   FWrite( ::hFile, Chr( 49 ) + Chr( 00 ), 2 )                    // FONT 0
   FWrite( ::hFile, Chr( 10 ) + Chr( 00 ), 2 )
   FWrite( ::hFile, Chr( 200 ) + Chr( 00 ), 2 )
   FWrite( ::hFile, Chr( 00 ) + Chr( 00 ), 2 )
   FWrite( ::hFile, Chr( 05 ), 1 )
   FWrite( ::hFile, "Arial", 5 )

   For n := 1 to 3
       if n > len( aFonts )
          FWrite( ::hFile, Chr( 49 ) + Chr( 00 ), 2 )             // FONT
          FWrite( ::hFile, Chr( 10 ) + Chr( 00 ), 2 )
          FWrite( ::hFile, Chr( 200 ) + Chr( 00 ), 2 )
          FWrite( ::hFile, Chr( 00 ) + Chr( 00 ), 2 )
          FWrite( ::hFile, Chr( 05 ), 1 )
          FWrite( ::hFile, "Arial", 5 )
       else
          nByte := 0; nLen := len( aFonts[ n, XLSFONT_NAME ] )    // FONT n
          FWrite( ::hFile, Chr( 49 ) + Chr( 00 ), 2 )
          FWrite( ::hFile, I2Bin( 05 + nLen ), 2 )
          FWrite( ::hFile, I2Bin( aFonts[ n, XLSFONT_HEIGHT ] ), 2 )
          nByte := nOR( nByte, if( aFonts[ n, XLSFONT_BOLD ], 1, 0 ) )
          nByte := nOR( nByte, if( aFonts[ n, XLSFONT_ITALIC ], 2, 0 ) )
          nByte := nOR( nByte, if( aFonts[ n, XLSFONT_UNDERLINE ], 4, 0 ) )
          nByte := nOR( nByte, if( aFonts[ n, XLSFONT_STRIKEOUT ], 8, 0 ) )
          FWrite( ::hFile, Chr( nByte ), 1 )
          FWrite( ::hFile, Chr( 00 ), 1 )
          FWrite( ::hFile, Chr( nLen ), 1 )
          FWrite( ::hFile, aFonts[ n, XLSFONT_NAME ], nLen )
         endif
   next

   FWrite( ::hFile, Chr( 64 ) + Chr( 00 ), 2 )      // BACKUP
   FWrite( ::hFile, Chr( 02 ) + Chr( 00 ), 2 )      // not back up
   FWrite( ::hFile, Chr( 00 ) + Chr( 00 ), 2 )

   FWrite( ::hFile, Chr( 31 ) + Chr( 00 ), 2 )      // FORMATCOUNT
   FWrite( ::hFile, Chr( 02 ) + Chr( 00 ), 2 )      // 1
   FWrite( ::hFile, Chr( 01 ) + Chr( 00 ), 2 )

   FWrite( ::hFile, Chr( 30 ) + Chr( 00 ), 2 )      // FORMAT 0
   FWrite( ::hFile, Chr( 08 ) + Chr( 00 ), 2 )
   FWrite( ::hFile, Chr( 07 ), 1 )
   FWrite( ::hFile, "General", 7 )

   For n := 1 to len( aFormats )
       nLen := len( aFormats[ n ] )
       FWrite( ::hFile, Chr( 30 ) + Chr( 00 ), 2 )  // FORMAT n
       FWrite( ::hFile, I2Bin( nLen + 1 ), 2 )
       FWrite( ::hFile, Chr( nLen ), 1 )
       FWrite( ::hFile, aFormats[ n ], nLen )
   next

return Self

//----------------------------------------------------------------------------//

METHOD End() CLASS TFileXLS

   local n
   local nLen

   local nReturn := 0

   nLen := Len( ::aHBreaks )                        // HORIZONTAL BREAK
   FWrite( ::hFile, Chr( 27 ) + Chr( 00 ), 2 )
   FWrite( ::hFile, I2Bin( 02 + nLen * 2 ), 2 )
   FWrite( ::hFile, I2Bin( nLen ), 2 )
   for n := 1 to nLen
      FWrite( ::hFile, I2Bin( ::aHBreaks[ n ] - 1 ), 2 )
   next

   nLen := Len( ::aVBreaks )                        // VERTICAL BREAK
   FWrite( ::hFile, Chr( 26 ) + Chr( 00 ), 2 )
   FWrite( ::hFile, I2Bin( 02 + nLen * 2 ), 2 )
   FWrite( ::hFile, I2Bin( nLen ), 2 )
   for n := 1 to nLen
      FWrite( ::hFile, I2Bin( ::aVBreaks[ n ] - 1 ), 2 )
   next

   FWrite( ::hFile, Chr( 18 ) + Chr( 00 ), 2 )      // PROTECT
   FWrite( ::hFile, Chr( 02 ) + Chr( 00 ), 2 )
   FWrite( ::hFile, Chr( if( ::lProtect, 1, 0 ) ) + Chr( 00 ), 2 )

   FWrite( ::hFile, Chr( 10 ) + Chr( 00 ), 2 )
   FWrite( ::hFile, Chr( 00 ) + Chr( 00 ), 2 )

   FClose( ::hFile )
   ::hFile := 0

   if ::lAutoexec
      // WinExec( "start Excel " + ::cName, 0 )
      // nReturn := ShellExecute( 0, 'Open', ::cName,,, 2 )
      nReturn := ShellExecute( if( ::oWnd != nil, ::oWnd:hWnd, GetActiveWindow() ), ;
                               'Open', ::cName,,, 2 )
   endif

return nReturn

//----------------------------------------------------------------------------//
// Support functions for TFileXLS class

FUNCTION XLSFont( cName, nHeight, ;
                  lBold, lItalic, lUnderline, lStrikeout )
  local nFont

  DEFAULT cName := "Arial", nHeight := 10, ;
          lBold := .f., lItalic := .f., lUnderline := .f., lStrikeout := .f.

  nFont := AScan( aFonts, {|a| a[1] == nHeight * 20 .and. ;
                               a[2] == lBold .and. ;
                               a[3] == lItalic .and. ;
                               a[4] == lUnderline .and. ;
                               a[5] == lStrikeout .and. ;
                               a[6] == cName } )

  if nFont == 0
     AAdd( aFonts, { nHeight * 20, lBold, lItalic, lUnderline, lStrikeout, cName } )
     nFont := Len( aFonts )
  endif

return nFont

//

FUNCTION XLSFormat( cPicture )

  local nFormat

  DEFAULT cPicture := "0"

  nFormat := AScan( aFormats, cPicture )

  if nFormat == 0
     AAdd( aFormats, cPicture )
     nFormat := Len( aFormats )
  endif

return nFormat

//

FUNCTION XLSClsFont()
return( aFonts := {} )

//

FUNCTION XLSClsFormat()
return( aFormats := {} )

//----------------------------------------------------------------------------//

METHOD SetDisplay( nTop, nLeft, nBottom, nRight, lHidden, ;
                   lFormulas, lGridLines, lHeaders, lNoZero )

  DEFAULT nTop := 0, nLeft := 0, nBottom := 200, nRight := 300

  FWrite( ::hFile, Chr( 61 ) + Chr( 00 ), 2 )       // WINDOWS1
  FWrite( ::hFile, Chr( 09 ) + Chr( 00 ), 2 )

  FWrite( ::hFile, I2Bin( nLeft * 20 ), 2 )
  FWrite( ::hFile, I2Bin( nTop * 20 ), 2 )
  FWrite( ::hFile, I2Bin( ( nRight - nLeft + 1 ) * 20 ), 2 )
  FWrite( ::hFile, I2Bin( ( nBottom - nTop + 1 ) * 20 ), 2 )
  FWrite( ::hFile, Chr( if( lHidden, 1, 0 ) ), 1 )

  FWrite( ::hFile, Chr( 62 ) + Chr( 00 ), 2 )       // WINDOWS2
  FWrite( ::hFile, Chr( 14 ) + Chr( 00 ), 2 )

  FWrite( ::hFile, Chr( if( lFormulas, 1, 0 ) ), 1 )
  FWrite( ::hFile, Chr( if( lGridLines, 1, 0 ) ), 1 )
  FWrite( ::hFile, Chr( if( lHeaders, 1, 0 ) ), 1 )
  FWrite( ::hFile, Chr( 00 ), 1 )
  FWrite( ::hFile, Chr( if( lNoZero, 0, 1 ) ), 1 )

  FWrite( ::hFile, I2Bin( 00 ), 2 )
  FWrite( ::hFile, I2Bin( 00 ), 2 )
  FWrite( ::hFile, Chr( 01 ), 1 )
  FWrite( ::hFile, L2Bin( 00 ), 4 )

return nil

//----------------------------------------------------------------------------//

METHOD SetPrinter( cHeader, cFooter, nLeft, nRight, nTop, nBottom, ;
                   lHeaders, lGredlines ) CLASS TFileXLS

   local nLen

   DEFAULT cHeader := "", cFooter := "", ;
           nLeft := 0, nRight := 0, nTop := 0, nBottom := 0, ;
           lHeaders := .f., lGredlines := .f.

   nLen := Len( cHeader )                           // HEADER
   FWrite( ::hFile, Chr( 20 ) + Chr( 00 ), 2 )
   if nLen == 0
      FWrite( ::hFile, Chr( 00 ) + Chr( 00 ), 2 )
   else
      FWrite( ::hFile, I2Bin( 01 + nLen ), 2 )
      FWrite( ::hFile, Chr( nLen ), 1 )
      FWrite( ::hFile, cHeader, nLen )
   endif

   nLen := Len( cFooter )                           // FOOTER
   FWrite( ::hFile, Chr( 21 ) + Chr( 00 ), 2 )
   if nLen == 0
      FWrite( ::hFile, Chr( 00 ) + Chr( 00 ), 2 )
   else
      FWrite( ::hFile, I2Bin( 01 + nLen ), 2 )
      FWrite( ::hFile, Chr( nLen ), 1 )
      FWrite( ::hFile, cFooter, nLen )
   endif

   FWrite( ::hFile, Chr( 38 ) + Chr( 00 ), 2 )      // LEFT MARGIN
   FWrite( ::hFile, Chr( 08 ) + Chr( 00 ), 2 )
   FWrite( ::hFile, D2Bin( nLeft ), 8 )

   FWrite( ::hFile, Chr( 39 ) + Chr( 00 ), 2 )      // RIGHT MARGIN
   FWrite( ::hFile, Chr( 08 ) + Chr( 00 ), 2 )
   FWrite( ::hFile, D2Bin( nRight ), 8 )

   FWrite( ::hFile, Chr( 40 ) + Chr( 00 ), 2 )      // TOP MARGIN
   FWrite( ::hFile, Chr( 08 ) + Chr( 00 ), 2 )
   FWrite( ::hFile, D2Bin( nTop ), 8 )

   FWrite( ::hFile, Chr( 41 ) + Chr( 00 ), 2 )      // BOTTOM MARGIN
   FWrite( ::hFile, Chr( 08 ) + Chr( 00 ), 2 )
   FWrite( ::hFile, D2Bin( nBottom ), 8 )

   FWrite( ::hFile, Chr( 42 ) + Chr( 00 ), 2 )      // PRINT HEADERS
   FWrite( ::hFile, Chr( 02 ) + Chr( 00 ), 2 )
   FWrite( ::hFile, Chr( if( lHeaders, 1, 0 ) ) + Chr( 00 ), 2 )

   FWrite( ::hFile, Chr( 43 ) + Chr( 00 ), 2 )      // PRINT GRIDLINES
   FWrite( ::hFile, Chr( 02 ) + Chr( 00 ), 2 )
   FWrite( ::hFile, Chr( if( lGredlines, 1, 0 ) ) + Chr( 00 ), 2 )

return nil

//----------------------------------------------------------------------------//

METHOD _Row( nRow, nHeight ) CLASS TFileXLS

  DEFAULT nHeight := 12.75

  FWrite( ::hFile, Chr( 08 ) + Chr( 00 ), 2 )
  FWrite( ::hFile, Chr( 16 ) + Chr( 00 ), 2 )

  FWrite( ::hFile, I2Bin( nRow - 1 ), 2 )

  FWrite( ::hFile, I2Bin( 00 ), 2 )
  FWrite( ::hFile, I2Bin( 00 ), 2 )

  FWrite( ::hFile, I2Bin( nHeight * 20 ), 2 )

  FWrite( ::hFile, Chr( 00 ) + Chr( 00 ), 2 )

  FWrite( ::hFile, Chr( 00 ), 1 )

  FWrite( ::hFile, Chr( 00 ) + Chr( 00 ), 2 )

  FWrite( ::hFile, Chr( 00 ) + Chr( 00 ) + Chr( 00 ), 3 )

return nil

//----------------------------------------------------------------------------//

METHOD _Col( nFirstCol, nLastCol, nWidth, lHide )

  DEFAULT lHide := .f.
  DEFAULT nWidth := 10.71
  DEFAULT nLastCol := nFirstCol

  FWrite( ::hFile, Chr( 36 ) + Chr( 00 ), 2 )
  FWrite( ::hFile, Chr( 04 ) + Chr( 00 ), 2 )

  FWrite( ::hFile, Chr( nFirstCol - 1 ), 1 )
  FWrite( ::hFile, Chr( nLastCol - 1 ), 1 )

  if lHide
     FWrite( ::hFile, I2Bin( 0 ), 2 )
  else
     FWrite( ::hFile, I2Bin( Round( ( nWidth + 0.72 ) * 256, 0) ), 2 )
  endif

return nil

//----------------------------------------------------------------------------//

METHOD Blank( nRow, nCol, ;
              lHidden, lLocked, nFont, nFormat, lShaded, ;
              nBorder, nAlignament ) CLASS TFileXLS

  DEFAULT lHidden := .f., lLocked := .f., nFont := 0, nFormat := 0, lShaded := .f., ;
          nBorder := BORDER_NONE, nAlignament := ALING_NULL

  FWrite( ::hFile, Chr( 01 ) + Chr( 00 ), 2 )
  FWrite( ::hFile, Chr( 07 ) + Chr( 00 ), 2 )

  ::PutCoors( nRow, nCol )
  ::PutAttributes( lHidden, lLocked, nFont, nFormat, lShaded, ;
                   nBorder, nAlignament )

return nil

//----------------------------------------------------------------------------//

METHOD Number( nRow, nCol, nNumber, ;
               lHidden, lLocked, nFont, nFormat, lShaded, ;
               nBorder, nAlignament ) CLASS TFileXLS

  local lInteger := lInteger( nNumber )

  DEFAULT lHidden := .f., lLocked := .f., nFont := 0, nFormat := 0, lShaded := .f., ;
          nBorder := BORDER_NONE, nAlignament := ALING_NULL

  if lInteger
     FWrite( ::hFile, Chr( 02 ) + Chr( 00 ), 2 )
     FWrite( ::hFile, Chr( 09 ) + Chr( 00 ), 2 )
  else
     FWrite( ::hFile, Chr( 03 ) + Chr( 00 ), 2 )
     FWrite( ::hFile, Chr( 15 ) + Chr( 00 ), 2 )
  endif

  ::PutCoors( nRow, nCol )
  ::PutAttributes( lHidden, lLocked, nFont, nFormat, lShaded, ;
                   nBorder, nAlignament )

  if lInteger
     FWrite( ::hFile, I2Bin( nNumber ), 2 )
  else
     FWrite( ::hFile, D2Bin( nNumber ), 8 )
  endif

return nil

//----------------------------------------------------------------------------//

METHOD String( nRow, nCol, cString, ;
               lHidden, lLocked, nFont, nFormat, lShaded, ;
               nBorder, nAlignament ) CLASS TFileXLS

  local nLen := Len( cString )

  DEFAULT lHidden := .f., lLocked := .f., nFont := 0, nFormat := 0, lShaded := .f., ;
          nBorder := BORDER_NONE, nAlignament := ALING_NULL

  FWrite( ::hFile, Chr( 04 ) + Chr( 00 ), 2 )
  FWrite( ::hFile, I2Bin( 08 + nLen ), 2 )

  ::PutCoors( nRow, nCol )
  ::PutAttributes( lHidden, lLocked, nFont, nFormat, lShaded, ;
                   nBorder, nAlignament )

  FWrite( ::hFile, Chr( nLen ), 1 )
  FWrite( ::hFile, cString, nLen )

return nil

//----------------------------------------------------------------------------//

METHOD _Date( nRow, nCol, dDate, ;
              lHidden, lLocked, nFont, nFormat, lShaded, ;
              nBorder, nAlignament ) CLASS TFileXLS

  local nDate

  DEFAULT lHidden := .f., lLocked := .f., nFont := 0, nFormat := 0, lShaded := .f., ;
          nBorder := BORDER_NONE, nAlignament := ALING_NULL

  FWrite( ::hFile, Chr( 02 ) + Chr( 00 ), 2 )
  FWrite( ::hFile, Chr( 09 ) + Chr( 00 ), 2 )

  ::PutCoors( nRow, nCol )
  ::PutAttributes( lHidden, lLocked, nFont, nFormat, lShaded, ;
                   nBorder, nAlignament, 0 )

  nDate := dDate - CToD( "01/01/1900" ) + 2

  FWrite( ::hFile, I2Bin( nDate ), 2 )

return nil

//----------------------------------------------------------------------------//

METHOD Boolean( nRow, nCol, lBoolean, ;
                lHidden, lLocked, nFont, nFormat, lShaded, ;
                nBorder, nAlignament ) CLASS TFileXLS

  DEFAULT lHidden := .f., lLocked := .f., nFont := 0, nFormat := 0, lShaded := .f., ;
          nBorder := BORDER_NONE, nAlignament := ALING_NULL

  FWrite( ::hFile, Chr( 05 ) + Chr( 00 ), 2 )
  FWrite( ::hFile, Chr( 09 ) + Chr( 00 ), 2 )

  ::PutCoors( nRow, nCol )
  ::PutAttributes( lHidden, lLocked, nFont, nFormat, lShaded, ;
                   nBorder, nAlignament )

  FWrite( ::hFile, Chr( if( lBoolean, 1, 0 ) ), 1 )
  FWrite( ::hFile, Chr( 00 ), 1 )

return nil

//----------------------------------------------------------------------------//

METHOD Formula( nRow, nCol, nNumber, lRecalc, cFormula, ;
                lHidden, lLocked, nFont, nFormat, lShaded, ;
                nBorder, nAlignament ) CLASS TFileXLS

  local cExpression := GetExpression( cFormula )
  local nLen := Len( cExpression )

  DEFAULT nNumber := 0, lRecalc := .t.

  DEFAULT lHidden := .f., lLocked := .f., nFont := 0, nFormat := 0, lShaded := .f., ;
          nBorder := BORDER_NONE, nAlignament := ALING_NULL

  FWrite( ::hFile, Chr( 06 ) + Chr( 00 ), 2 )
  FWrite( ::hFile, I2Bin( 17 + nLen ), 2 )

  ::PutCoors( nRow, nCol )
  ::PutAttributes( lHidden, lLocked, nFont, nFormat, lShaded, ;
                   nBorder, nAlignament )

  FWrite( ::hFile, D2Bin( nNumber ), 8 )

  FWrite( ::hFile, Chr( if( lRecalc, 2, 0 ) ), 1 )

  FWrite( ::hFile, Chr( nLen ), 1 )
  FWrite( ::hFile, cExpression, nLen )

return nil

//----------------------------------------------------------------------------//

METHOD Say( nRow, nCol, uVal, ;
            lHidden, lLocked, nFont, nFormat, lShaded, ;
            nBorder, nAlignament ) CLASS TFileXLS

  local cType := ValType( uVal )

  if cType == "B"
     uVal := Eval( uVal )
     cType := ValType( uVal )
  endif

  do case
     case cType == "N"
          ::Number( nRow, nCol, uVal, ;
                    lHidden, lLocked, nFont, nFormat, lShaded, ;
                    nBorder, nAlignament )

     case cType == "C" .or. cType == "M"
          ::String( nRow, nCol, uVal, ;
                    lHidden, lLocked, nFont, nFormat, lShaded, ;
                    nBorder, nAlignament )

     case cType == "D"
          ::_Date( nRow, nCol, uVal, ;
                   lHidden, lLocked, nFont, nFormat, lShaded, ;
                   nBorder, nAlignament )

     case cType == "L"
          ::Boolean( nRow, nCol, uVal, ;
                     lHidden, lLocked, nFont, nFormat, lShaded, ;
                     nBorder, nAlignament )

     case cType == "U"
          ::Blank( nRow, nCol, ;
                   lHidden, lLocked, nFont, nFormat, lShaded, ;
                   nBorder, nAlignament )

     otherwise
          Eval( ErrorBlock(), _XLSGenError( DATATYPE_NOSUPPORT, ;
                                    CHR(13)+CHR(10) + "Type: " + cType ) )

  endcase

return nil

//----------------------------------------------------------------------------//

METHOD Error( nRow, nCol, nError, ;
              lHidden, lLocked, nFont, nFormat, lShaded, ;
              nBorder, nAlignament ) CLASS TFileXLS

  DEFAULT lHidden := .f., lLocked := .f., nFont := 0, nFormat := 0, lShaded := .f., ;
          nBorder := BORDER_NONE, nAlignament := ALING_NULL

  FWrite( ::hFile, Chr( 05 ) + Chr( 00 ), 2 )
  FWrite( ::hFile, Chr( 09 ) + Chr( 00 ), 2 )

  ::PutCoors( nRow, nCol )
  ::PutAttributes( lHidden, lLocked, nFont, nFormat, lShaded, ;
                   nBorder, nAlignament )

  FWrite( ::hFile, Chr( nError ), 1 )
  FWrite( ::hFile, Chr( 01 ), 1 )

return nil

//----------------------------------------------------------------------------//

METHOD Note( nRow, nCol, cNote ) CLASS TFileXLS

  local nLen := Len( cNote )

  FWrite( ::hFile, Chr( 28 ) + Chr( 00 ), 2 )
  FWrite( ::hFile, I2Bin( 06 + nLen ), 2 )

  ::PutCoors( nRow, nCol )

  FWrite( ::hFile, I2Bin( nLen ), 2 )
  FWrite( ::hFile, cNote, nLen )

return nil

//----------------------------------------------------------------------------//

METHOD AddBreak( cCourse, aBreaks ) CLASS TFileXLS

  DEFAULT cCourse := "HORIZONTAL"

  do case
     case cCourse == "HORIZONTAL"
          AEval( aBreaks, {|nBreak| if( AScan( ::aHBreaks, nBreak ) == 0, ;
                                        AAdd( ::aHBreaks, nBreak ), ) } )
          ASort( ::aHBreaks )

     case cCourse == "VERTICAL"
          AEval( aBreaks, {|nBreak| if( AScan( ::aVBreaks, nBreak ) == 0, ;
                                        AAdd( ::aVBreaks, nBreak ), ) } )
          ASort( ::aVBreaks )

  endcase

return nil

//----------------------------------------------------------------------------//

METHOD PutCoors( nRow, nCol ) CLASS TFileXLS

  local cWord

  cWord := I2Bin( nRow - 1 )
  FWrite( ::hFile, @cWord, 2 ) //  Byte Offset 0-1

  cWord := I2Bin( nCol - 1 )
  FWrite( ::hFile, @cWord, 2 ) //  Byte Offset 2-3

return nil

//----------------------------------------------------------------------------//

METHOD PutAttributes( lHidden, lLocked, nFont, nFormat, lShaded, ;
                      nBorder, nAlignament, nReserved ) CLASS TFileXLS

  local nByte, cByte

  DEFAULT nReserved := 0

  nByte := 0
  if lHidden
     nByte := 128
  endif
  if lLocked
     nByte := nOR( nByte, 64 )
  endif
  nByte := nOR( nByte, nReserved )

  cByte := Chr( nByte )
  FWrite( ::hFile, @cByte, 1 )  //  Byte Offset 0

  if nFont == 0
     nByte := 0
  elseif nFont == 1
     nByte := 64
  elseif nFont == 2
     nByte := 128
  else
     nByte := 192
  endif
  nByte := nOR( nByte, nFormat )

  cByte := Chr( nByte )
  FWrite( ::hFile, @cByte, 1 )  //  Byte Offset 1

  nByte := 0
  if lShaded
     nByte := 128
  endif
  nByte := nOR( nByte, nBorder )
  nByte := nOR( nByte, nAlignament )

  cByte := Chr( nByte )
  FWrite( ::hFile, @cByte, 1 )  //  Byte Offset 3

return nil


//  Static functions
//----------------------------------------------------------------------------//

static function GetExpression( cFormula )

  local n, nLen

  local cExpression := ""
  local cLabel:= "", cNumber := "", cFunction := ""

  local cOperator := "", nPart, cChar, cSign := ""

  local lOperator := .f., lFunction := .f., lParenthetically := .f.

  local aBuffer := {}

  cFormula := StrTran( cFormula, " ", "" )
  nLen := Len( cFormula )

  n := 1

  do while n <= nLen

     cChar := Upper( SubStr( cFormula, n, 1 ) )

     do case

        case cChar $ "0123456789."
             if empty( cLabel )
                cNumber += cChar
             else
                cLabel += cChar
             endif

        case Asc( cChar ) >= 65 .and. Asc( cChar ) <= 90 ;
             .or. cChar == "_"
             cLabel += cChar

        case cChar $ "+-*/^"
             if lParenthetically .or. ;
                !empty( cNumber ) .or. !empty( cLabel ) .or. !empty( cfunction )

                if empty( cOperator )
                elseif ( cChar$"*/^" .and. cOperator$"+-" ).or. ;
                       ( cChar$"^" .and. cOperator$"*/" )
                       AAdd( aBuffer, cOperator )
                       cOperator := ""
                       lParenthetically := .f.
                elseif ( cChar$"+-" .and. cOperator$"*/^" ).or. ;
                       ( cChar$"*/" .and. cOperator$"^" )
                       lOperator := .t.
                endif

                if !empty( cNumber )
                   cExpression += GetNumber( Val( cNumber ), cSign, cOperator )
                elseif !empty ( cLabel )
                   cExpression += GetNumber( &cLabel, cSign, cOperator )
                elseif !empty( cfunction )
                   cExpression += GetFunction( cFunction, cSign, cOperator )
                endif
                cNumber := cLabel := cFunction := ""

                if lParenthetically
                   if !empty( cOperator )
                      cExpression += Chr( AScan( aOperators, cOperator ) )
                   endif
                   lParenthetically := .f.
                endif

                if lOperator
                   do while len( aBuffer ) != 0 .and. Atail( aBuffer ) != "P"
                      if !empty( Atail( aBuffer ) )
                         cExpression += Chr( AScan( aOperators, Atail( aBuffer ) ) )
                      endif
                      ASize( aBuffer, len( aBuffer ) - 1 )
                   enddo
                   lOperator := .f.
                endif
                cOperator := cChar

                cSign := ""

             else

                cSign := cChar

             endif

        case cChar == "("
             if empty( cLabel )

                AAdd( aBuffer, cOperator )
                AAdd( aBuffer, "P" )
                cOperator := ""

             else

                #ifdef _MSLINK_
                lFunction := Upper( Left( clabel, 3 ) ) == "XLS"
                #else
                lFunction := Left( clabel, 1 ) == "_"
                #endif

                nPart := 1
                cLabel += "("
                do while nPart != 0
                   n++
                   cChar := SubStr( cFormula, n, 1 )
                   do case
                      case cChar == "("
                           nPart++
                      case cChar == ")"
                           nPart--
                      case lFunction .and. ;
                           cChar == "," .and. nPart = 1
                           cChar := ";"
                   endcase
                   cLabel += cChar
                enddo

                if lFunction
                   cFunction := cLabel
                   cLabel := ""
                else
                   cLabel := AllTrim( cValToChar( &cLabel ) )
                endif

             endif

        case cChar == ")"
             if !empty( cNumber )
                cExpression += GetNumber( Val( cNumber ), cSign, cOperator )
             elseif !empty ( cLabel )
                cExpression += GetNumber( &cLabel, cSign, cOperator )
             elseif !empty( cfunction )
                cExpression += GetFunction( cFunction, cSign, cOperator )
             endif
             cNumber := cLabel := cFunction := ""

             if lParenthetically
                if !empty( cOperator )
                   cExpression += Chr( AScan( aOperators, cOperator ) )
                endif
                lParenthetically := .f.
             endif

             do while Atail( aBuffer ) != "P"
                if !empty( Atail( aBuffer ) )
                   cExpression += Chr( AScan( aOperators, Atail( aBuffer ) ) )
                endif
                ASize( aBuffer, len( aBuffer ) - 1 )
             enddo
             cExpression += Chr( 21 )
             ASize( aBuffer, len( aBuffer ) - 1 )
             cOperator := Atail( aBuffer )
             ASize( aBuffer, len( aBuffer ) - 1 )
             lParenthetically := .t.

        otherwise
             Eval( ErrorBlock(), _XLSGenError( SYNTATIC_ERROR, ;
                                      CHR(13)+CHR(10) + cChar ) )
      endcase

      n++

  enddo

  if !empty( cNumber )
     cExpression += GetNumber( Val( cNumber ), cSign, cOperator )
  elseif !empty( cLabel )
     cExpression += GetNumber( &cLabel, cSign, cOperator )
  elseif !empty( cfunction )
     cExpression += GetFunction( cFunction, cSign, cOperator )
  endif

  if lParenthetically
     if !empty( cOperator )
        cExpression += Chr( AScan( aOperators, cOperator ) )
     endif
     lParenthetically := .f.
  endif

  do while len( aBuffer ) != 0
     cOperator := Atail( aBuffer )
     if cOperator == "P"
        cExpression += Chr( 21 )
     else
        if !empty( cOperator )
           cExpression += Chr( AScan( aOperators, cOperator ) )
        endif
     endif
     ASize( aBuffer, len( aBuffer ) - 1 )
  enddo

return cExpression

//----------------------------------------------------------------------------//

Static function GetNumber( nNumber, cSign, cOperator )

  local cExpression := ""

  nNumber *= if( cSign == "-", -1, +1 )

  if lInteger( nNumber )
     cExpression += Chr( 30 )
     cExpression += I2Bin( nNumber )
  else
     cExpression += Chr( 31 )
     cExpression += D2Bin( nNumber )
  endif

  if !empty( cOperator )
     cExpression += Chr( AScan( aOperators, cOperator ) )
  endif

return cExpression

//----------------------------------------------------------------------------//

Static function GetFunction( cFunction, cSign, cOperator )

  local cExpression := ""
  local n, nType, cVal, nVal, nPar := 1, aPar := {}, aVal := {}, uVal

  local cName := Left( cFunction, At( "(", cFunction ) - 1 )
  local cParameters := SubStr( cFunction, At( "(", cFunction ) )

  cParameters := SubStr( cParameters, 2, len( cParameters ) - 2 )
  do while ( n := At( ";", SubStr( cParameters, nPar ) ) ) != 0
     cVal := SubStr( cParameters, nPar, n - 1 )
     AAdd( aPar, cVal )
     uVal := &cVal
     AAdd( aVal, uVal )
     nPar += n
  enddo
  if !empty( cParameters )
     cVal := SubStr( cParameters, nPar )
     AAdd( aPar, cVal )
     uVal := &cVal
     AAdd( aVal, uVal )
  endif

  do case

     //  Funct. Cell.

     #ifdef _MSLINK_
     case cName == "XLSCELL"
     #else
     case cName == "_CELL"
     #endif
          cExpression += Chr( 68 )
          nType := 192
          if len( aVal ) > 3 .and. aVal[ 4 ]
             nType -= 64
          endif
          if len( aVal ) > 2 .and. aVal[ 3 ]
             nType -= 128
          endif
          nVal := aVal[ 1 ] - 1
          cExpression += Chr( nLoByte( nVal ) ) + Chr( nHiByte( nVal ) + nType )
          nVal := aVal[ 2 ] - 1
          cExpression += Chr( nVal )

     #ifdef _MSLINK_
     case cName == "XLSSUM"
     #else
     case cName == "_SUM"
     #endif
          cExpression += Chr( 37 )
          nType := 192
          if len( aVal ) > 5 .and. aVal[ 6 ]
             nType -= 64
          endif
          if len( aVal ) > 4 .and. aVal[ 5 ]
             nType -= 128
          endif
          nVal := aVal[ 1 ] - 1
          cExpression += Chr( nLoByte( nVal ) ) + Chr( nHiByte( nVal ) + nType )
          nType := 192
          if len( aVal ) > 7 .and. aVal[ 8 ]
             nType -= 64
          endif
          if len( aVal ) > 6 .and. aVal[ 7 ]
             nType -= 128
          endif
          nVal := aVal[ 3 ] - 1
          cExpression += Chr( nLoByte( nVal ) ) + Chr( nHiByte( nVal ) + nType )
          nVal := aVal[ 2 ] - 1
          cExpression += Chr( nVal )
          nVal := aVal[ 4 ] - 1
          cExpression += Chr( nVal )
          cExpression += Chr( 25 ) + Chr( 16 ) + Chr( 00 )

     #ifdef _MSLINK_
     case cName == "XLSMULT"
     #else
     case cName == "_MULT"
     #endif
          cExpression += Chr( 37 )
          nType := 192
          if len( aVal ) > 5 .and. aVal[ 6 ]
             nType -= 64
          endif
          if len( aVal ) > 4 .and. aVal[ 5 ]
             nType -= 128
          endif
          nVal := aVal[ 1 ] - 1
          cExpression += Chr( nLoByte( nVal ) ) + Chr( nHiByte( nVal ) + nType )
          nType := 192
          if len( aVal ) > 7 .and. aVal[ 8 ]
             nType -= 64
          endif
          if len( aVal ) > 6 .and. aVal[ 7 ]
             nType -= 128
          endif
          nVal := aVal[ 3 ] - 1
          cExpression += Chr( nLoByte( nVal ) ) + Chr( nHiByte( nVal ) + nType )
          nVal := aVal[ 2 ] - 1
          cExpression += Chr( nVal )
          nVal := aVal[ 4 ] - 1
          cExpression += Chr( nVal )
          cExpression += Chr( 66 ) + Chr( 01 ) + Chr( 183 )

     // Funct. Math

     #ifdef _MSLINK_
     case cName == "XLSABS"
     #else
     case cName == "_ABS"
     #endif
          cExpression += GetExpression( aPar[ 1 ] )
          cExpression += Chr( 65 ) + Chr( 24 )

     #ifdef _MSLINK_
     case cName == "XLSINTE"
     #else
     case cName == "_INTE"
     #endif
          cExpression += GetExpression( aPar[ 1 ] )
          cExpression += Chr( 65 ) + Chr( 25 )

     #ifdef _MSLINK_
     case cName == "XLSMOD"
     #else
     case cName == "_MOD"
     #endif
          cExpression += GetExpression( aPar[ 1 ] )
          cExpression += GetExpression( aPar[ 2 ] )
          cExpression += Chr( 65 ) + Chr( 39 )

     #ifdef _MSLINK_
     case cName == "XLSROUND"
     #else
     case cName == "_ROUND"
     #endif
          cExpression += GetExpression( aPar[ 1 ] )
          cExpression += GetExpression( aPar[ 2 ] )
          cExpression += Chr( 65 ) + Chr( 27 )

     #ifdef _MSLINK_
     case cName == "XLSSIGN"
     #else
     case cName == "_SIGN"
     #endif
          cExpression += GetExpression( aPar[ 1 ] )
          cExpression += Chr( 65 ) + Chr( 26 )

     #ifdef _MSLINK_
     case cName == "XLSSQRT"
     #else
     case cName == "_SQRT"
     #endif
          cExpression += GetExpression( aPar[ 1 ] )
          cExpression += Chr( 65 ) + Chr( 20 )

     #ifdef _MSLINK_
     case cName == "XLSEXP"
     #else
     case cName == "_EXP"
     #endif
          cExpression += GetExpression( aPar[ 1 ] )
          cExpression += Chr( 65 ) + Chr( 21 )

     #ifdef _MSLINK_
     case cName == "XLSLN"
     #else
     case cName == "_LN"
     #endif
          cExpression += GetExpression( aPar[ 1 ] )
          cExpression += Chr( 65 ) + Chr( 22 )

     #ifdef _MSLINK_
     case cName == "XLSLOG"
     #else
     case cName == "_LOG"
     #endif
          cExpression += GetExpression( aPar[ 1 ] )
          cExpression += Chr( 65 ) + Chr( 23 )

     #ifdef _MSLINK_
     case cName == "XLSPI"
     #else
     case cName == "_PI"
     #endif
          cExpression += Chr( 65 ) + Chr( 19 )

     #ifdef _MSLINK_
     case cName == "XLSRANDOM"
     #else
     case cName == "_RANDOM"
     #endif
          cExpression += Chr( 65 ) + Chr( 63 )

     #ifdef _MSLINK_
     case cName == "XLSSIN"
     #else
     case cName == "_SIN"
     #endif
          cExpression += GetExpression( aPar[ 1 ] )
          cExpression += Chr( 65 ) + Chr( 15 )

     #ifdef _MSLINK_
     case cName == "XLSCOS"
     #else
     case cName == "_COS"
     #endif
          cExpression += GetExpression( aPar[ 1 ] )
          cExpression += Chr( 65 ) + Chr( 16 )

     #ifdef _MSLINK_
     case cName == "XLSTAN"
     #else
     case cName == "_TAN"
     #endif
          cExpression += GetExpression( aPar[ 1 ] )
          cExpression += Chr( 65 ) + Chr( 17 )

     #ifdef _MSLINK_
     case cName == "XLSASIN"
     #else
     case cName == "_ASIN"
     #endif
          cExpression += GetExpression( aPar[ 1 ] )
          cExpression += Chr( 65 ) + Chr( 98 )

     #ifdef _MSLINK_
     case cName == "XLSACOS"
     #else
     case cName == "_ACOS"
     #endif
          cExpression += GetExpression( aPar[ 1 ] )
          cExpression += Chr( 65 ) + Chr( 99 )

     #ifdef _MSLINK_
     case cName == "XLSATAN"
     #else
     case cName == "_ATAN"
     #endif
          cExpression += GetExpression( aPar[ 1 ] )
          cExpression += Chr( 65 ) + Chr( 18 )

     otherwise
         Eval( ErrorBlock(), _XLSGenError( NODEFINED_FUNCTION, ;
                         CHR(13)+CHR(10) + "Function: " + cName ) )
  endcase

  if !empty( cSign )
     cExpression += Chr( AScan( aOperators, cSign ) + 15 )
  endif

  if !empty( cOperator )
     cExpression += Chr( AScan( aOperators, cOperator ) )
  endif

return cExpression

//----------------------------------------------------------------------------//

Static function lInteger( nNumber )
return nNumber <= 65535 .and. nNumber >= 0 .and. ;
     ( nNumber - INT( nNumber ) ) == 0


XLSError.prg

Code: Select all  Expand view

// FileXLS automatic error generation

#include "Error.ch"
//#include "XLSError.ch"

external ProcName, ErrorSys

#define _SUBSYS_       "FileXLS"

#define ERR_MESSAGE    1
#define ERR_SEVERITY   2
#define ERR_SUBSYS     3
#define ERR_ERR_NO     4

//----------------------------------------------------------------------------//

FUNCTION _XLSGenError( nError, cOperation )

local aErr := { { "Non defined XLS function", ES_CATASTROPHIC,, },;
                 { "Formula syntactic error", ES_CATASTROPHIC,, },;
                 { "Data type XLS no support", ES_WARNING,, } }

local oError

if nError > 0 .and. nError <= MAX_DEFINED_ERRORS

    oError = ErrorNew()

    oError:Severity    = aErr[ nError ][ ERR_SEVERITY ]
    oError:CanDefault  = oError:Severity < ES_CATASTROPHIC
    oError:SubSystem   = If( aErr[ nError ][ ERR_SUBSYS ] == nil,;
                        _SUBSYS_ ,;
                        aErr[ nError ][ ERR_SUBSYS ] )
    oError:SubCode     = If( aErr[ nError ][ ERR_ERR_NO ] == nil,;
                        nError,;
                        aErr[ nError ][ ERR_ERR_NO ] )
    oError:Description = aErr[ nError ][ ERR_MESSAGE ]
    oError:Operation   = cOperation

endif

return oError


XLSFunc.prg

Code: Select all  Expand view

// Compatibility XLS functions

//#define _MSLINK_

#ifdef _MSLINK_

// Funct. cells

function xlsCELL(); return 1

function xlsSUM(); return 1
function xlsMULT(); return 1

// Funct. Math.

function xlsABS(); return 1
function xlsINTE(); return 1
function xlsMOD(); return 1
function xlsROUND(); return 1
function xlsSIGN(); return 1

function xlsSQRT(); return 1
function xlsEXP(); return 1
function xlsLN(); return 1
function xlsLOG(); return 1

function xlsPI(); return 1
function xlsRANDOM(); return 1

function xlsSIN(); return 1
function xlsCOS(); return 1
function xlsTAN(); return 1
function xlsASIN(); return 1
function xlsACOS(); return 1
function xlsATAN(); return 1

#else

// Funct. cells

function _CELL(); return 1

function _SUM(); return 1
function _MULT(); return 1

// Funct. Math.

function _ABS(); return 1
function _INTE(); return 1
function _MOD(); return 1
function _ROUND(); return 1
function _SIGN(); return 1

function _SQRT(); return 1
function _EXP(); return 1
function _LN(); return 1
function _LOG(); return 1

function _PI(); return 1
function _RANDOM(); return 1

function _SIN(); return 1
function _COS(); return 1
function _TAN(); return 1
function _ASIN(); return 1
function _ACOS(); return 1
function _ATAN(); return 1

#endif


[anserkk]

Mr.Antonio,

Muchas gracias.

Ramon Paredes,

¿Me puede dar una muestra PRG muestra el uso de la clase

Saludos

Anser

[Ramon Paredes]

Anserkk :

Baja este archivo comprimido, ahi va ejemplo.prg donde te pongo dos ejemplos con filexls uno con un listado y uno con estadisticas y cuadros desde codigo, va ademas rgen1.dbf los datos de prueba y filexls.ch que no te lo habia proporcionado, el ejecutable que va ahi es el ejemplo compilado con fwh8.02 + xharboru 1.1., ojala te sea de utilidad

http://www.megaupload.com/es/?d=TQB41T0Z

Saludos desde Managua, Nicaragua

Ramon Paredes

[anserkk]

Ramon Paredes,

Muchas gracias.

Anser

[anserkk]

Dear Ramon Paredes,

Can you confirm that whether I need MS-Excel to be installed on the PC for the CLASS FileXLS to work ? In the sample which you have given I found that OLE "Excel.Application" is used, but in the CLASS FileXls I did not see any reference.

I am looking for a CLASS which can create .XLS file, even if MS-Excel is not installed on the PC running the FWH application
For Eg CLASS Txls but with more functionalities like your CLASS FileXLS. CLASS FileXLS has more fuctionalities in formatting and formulas
------------------------------------------
¿Puede usted confirmar que si necesito MS-Excel debe estar instalado en el PC para la CLASS FileXLS para trabajar? En la muestra que usted ha dado en mi opinión, OLE "Excel.Application" se utiliza, pero en la CLASS FileXls no vi ninguna referencia.

Estoy buscando una clase que puede crear. Archivo XLS, aunque MS-Excel no está instalado en el PC que ejecuta la aplicación FWH
Por ejemplo, para la CLASS Txls pero con más funcionalidades que su FileXLS CLASS. CLASS FileXLS tiene más fuctionalities en formato y las fórmulas

Code: Select all  Expand view

oExcel := TOleAuto():New( "Excel.Application" )
oHoja := oExcel:Get( "ActiveSheet" )

DEFINE XLS FORMAT nFormat1 PICTURE '#,##0' // para pesetas
DEFINE XLS FORMAT nFormat2 PICTURE '#,##0.00' // para euros

XLS oFileXLS FILE "MAESTRO1.XLS" //AUTOEXEC


Anser

[Ramon Paredes]

anserkk :

Esta clase crea hoja xls sin necesidad de tener instalado excel, es una de las ventajas, ahora sus funcionalidades estan limitadas hasta donde su autor las dejo, nadie ha ampliado la misma, hasta donde tengo entendido, es muy agil para reportes que no demanden muchos retoques,

Slaudos desde Managua, Nicaragua

Ramon Paredes

[anserkk]

Dear Ramon Paredes,

Esta clase crea hoja xls sin necesidad de tener instalado excel

Muchas gracias

Saludos

Anser

[ManolinM2008]

He encontrado una solución usando TPrinter para enviar directamente a Excel sin ir al previo
Usa TFileXls junto con estos programas. Sin embargo hay que adicionar en el reporte lo siguiente:

If lExcel
If lPrevio
PRINT oPrn NAME cDoc PREVIEW SELECTION
Else
PRINT oPrn NAME cDoc
Endif
Else
If lPrevio
PRINT oPrn NAME cDoc PREVIEW
Else
PRINT oPrn NAME cDoc
Endif
Endif

Tambien es necesario agregar
If lExcel
Else
If nFil > 26.5
nFil := 1


Es Todo

// programa TMPRINTER
#Include "FiveWin.ch"
#include "FileXLS.ch"

Static oPrinter

CLASS TMPrinter FROM TPrinter

DATA lSalida AS LOGICAL INIT .T.
DATA bPreInit
DATA oSalida
DATA nRow
DATA nCol
Data cDoc
DATA lFin AS LOGICAL INIT .F.
//Redefiniendo Methods
METHOD New( cDoc, lUser, lPreview, cModel, lModal, lSelection ) CONSTRUCTOR
METHOD Activate()
METHOD CmSay( nCol, xText, nFont, nPad, nRow )
METHOD Stabilize()
METHOD End()
METHOD SayBitmap( nRow, nCol, cBitmap, nWidth, nHeight, nScale )
METHOD Box( nRow, nCol, nBottom, nRight, nPen, nScale )
METHOD Line( nTop, nLeft, nBottom, nRight, nPen, nScale )
METHOD Shadow( nHeight )
METHOD Grid( nHeight, nRow, cChar )
METHOD Separator( nPen, nRow )

ENDCLASS

METHOD New( cDoc, lUser, lPreview, cModel, lModal, lSelection ) CLASS TMPrinter

Local uReturn // := Super:New( cDoc, lUser, lPreview,, lModal, lSelection )

PUBLIC lFin := .F.
PUBLIC nRow
DEFINE FONT oFont NAME "Arial" SIZE 0,-11

If ::lSalida // := .T.
cDocumento := cDoc
::oSalida := TSalPrinterXls():New( Self, AllTrim( Left( cDocumento, 8 ) ) + '.xls' )
Else
uReturn := Super:New( cDoc, lUser, lPreview,, lModal, lSelection )
Endif

Return Self

METHOD Activate() CLASS TMPrinter

Local oPagina
Local hActWnd := GetActiveWindow()

::hOldRes := GetResources()

#ifdef __CLIPPER__
SET RESOURCES TO "preview.dll"
#else
SET RESOURCES TO "prev32.dll"
#endif

If GetResources() < 32
#ifdef __CLIPPER__
MsgStop( "Preview.dll not found", "Error" )
#else
MsgStop( "Prev32.dll not found", "Error" )
#endif
SetResources(::hOldRes)
RETU NIL
EndIf
// Estabilizar el listado
IF !::lCreated
::End()
RETU NIL
ENDIF
::Stabilize()
IF !::lStable
::End()
RETURN NIL
ENDIF

Return Nil

METHOD CmSay( nRow, nCol, xText, oFont, nWidth, nClrText, nBkMode, nPad ) CLASS TMPrinter

Local cPicture1 := "@!", cPicture2 := "@99,999,999.99", nFont := oFont:nHeight

If ::lSalida
nRow := Int( Round( ( nRow * 10 / 3)+0.5, 1 ) )
nCol := Int( Round(nCol+0.5,1) ) // Int( Round( ( nCol * 125 / 25.5 )+0.5,1 ))
nRow2 := nRow
// MsgInfo(Str(nRow)+"<<>>"+Str(nCol))
::oSalida:Say( nCol, xText, nFont, nPad, nRow, cPicture1 )
Else
If ValType( xText ) == 'N' .and. !Empty( cPicture2 )
xText:= Transform( xText, cPicture2 )
EndIf
Super:CmSay( nRow, nCol, xText, oFont, nWidth, nClrText, nBkMode, nPad )
EndIf

Return Nil

METHOD Stabilize() CLASS TMPrinter

If ::lSalida
::oSalida:Stabilize()
Else
Super:Stabilize()
EndIf

Return Nil

METHOD End() CLASS TMPrinter

If ::lSalida
::oSalida:Save()
Else
Endif

Return Nil

METHOD SayBitmap( nRow, nCol, cBitmap, nWidth, nHeight, nScale ) CLASS TMPrinter

If ::lSalida
//
Else
Super:SayBitmap( nRow, nCol, cBitmap, nWidth, nHeight, nScale )
EndIf

Return Nil

METHOD Box( nRow, nCol, nBottom, nRight, nPen, nScale ) CLASS TMPrinter

If ::lSalida
//
Else
Super:Box( nRow, nCol, nBottom, nRight, nPen, nScale )
EndIf

Return Nil

METHOD Line( nTop, nLeft, nBottom, nRight, nPen, nScale ) CLASS TMPrinter

If ::lSalida
//
Else
Super:Line( nTop, nLeft, nBottom, nRight, nPen, nScale )
EndIf

Return Nil

METHOD Shadow( nHeight ) CLASS TMPrinter

If ::lSalida
//
Else
Super:Shadow( nHeight )
EndIf

Return Nil

METHOD Grid( nHeight, nRow, cChar ) CLASS TMPrinter

If ::lSalida
//
Else
Super:Grid( nHeight, nRow, cChar )
EndIf

Return Nil

METHOD Separator( nPen, nRow ) CLASS TMPrinter

If ::lSalida
//
Else
Super:Separator(nPen, nRow)
EndIf

Return Nil

Function PrintBegin( cDoc, lUser, lPreview, xModel, lModal, lSelection )

local aPrn
local cText, cDevice
local nScan
PUBLIC lSalid2

lSalid2 := lSelection
If lSelection
if xModel == nil
return oPrinter := TMPrinter():New( cDoc, lUser, lPreview,, lModal, lSelection )
endif
cText := StrTran( GetProfString( "Devices" ),Chr(0), chr(13)+chr(10))
aPrn := Array( Mlcount( cText, 250 ) )
Aeval(aPrn, {|v,e| aPrn[e] := Trim(Memoline(cText, 250, e)) } )
if Valtype(xModel) == "N"
if xModel < 0 .or. xModel > len(aPrn)
nScan := 0
else
nScan := xModel
endif
else
if ( nScan := Ascan( aPrn, {|v| Upper( xModel ) == Upper( v ) } ) ) == 0
nScan = Ascan( aPrn, {|v| Upper( xModel ) $ Upper( v ) } )
endif
endif
if nScan == 0
MsgBeep()
return oPrinter := TMPrinter():New( cDoc, .T., lPreview,, lModal, lSelection )
endif
cText := GetProfString( "Devices", aPrn[ nScan ] )
cDevice := aPrn[ nScan ] + "," + cText
Else
if xModel == nil
return oPrinter := TPrinter():New( cDoc, lUser, lPreview,, lModal, lSelection )
endif
cText := StrTran( GetProfString( "Devices" ),Chr(0), chr(13)+chr(10))
aPrn := Array( Mlcount( cText, 250 ) )
Aeval(aPrn, {|v,e| aPrn[e] := Trim(Memoline(cText, 250, e)) } )
if Valtype(xModel) == "N"
if xModel < 0 .or. xModel > len(aPrn)
nScan := 0
else
nScan := xModel
endif
else
if ( nScan := Ascan( aPrn, {|v| Upper( xModel ) == Upper( v ) } ) ) == 0
nScan = Ascan( aPrn, {|v| Upper( xModel ) $ Upper( v ) } )
endif
endif
if nScan == 0
MsgBeep()
return oPrinter := TPrinter():New( cDoc, .T., lPreview,, lModal, lSelection )
endif
cText := GetProfString( "Devices", aPrn[ nScan ] )
cDevice := aPrn[ nScan ] + "," + cText
Endif

Return If(lSelection,oPrinter := TMPrinter():New( cDoc, .f., lPreview, cDevice, lModal, lSelection ),oPrinter := TPrinter():New( cDoc, .f., lPreview, cDevice, lModal, lSelection ))

Function PageBegin()

If lSalid2
//
Else
oPrinter:StartPage()
Endif

Return nil

Function PageEnd()

If lSalid2
// nRow debe continuar incrementandose
Else
oPrinter:EndPage()
Endif

Return nil

Function PrintEnd()

If lSalid2
oPrinter:End() // hay error al ejecutar esta opción.
Else
if oPrinter:lMeta
oPrinter:Preview()
else
oPrinter:End()
Endif
oPrinter := nil
Endif

Return nil

// TSalPrinter

#include "FileXLS.ch"
#include "FiveWin.ch"
#include "Report.ch"

CLASS TSalPrinterXLS

DATA oPrn
DATA oXls
DATA cFile
DATA aFont
DATA aFormat

DATA nRow

METHOD New( ) CONSTRUCTOR
METHOD Save()
// METHOD StartPage()
// METHOD EndPage()
METHOD Stabilize()
METHOD Say( nCol, xText, nFont, nPad, nRow, cPicture )

ENDCLASS

METHOD New( oPrn, cFile ) CLASS TSalPrinterXLS

DEFAULT cFile:= "MyFile.xls"

::aFont := {}
::aFormat:= {}
::cFile := cFile
::oPrn := oPrn
::nRow := 0
::oXls := TFileXLS():New( ::cFile, , , .F., .T. )
// cFileName,lAutomatic,nIterations,lProtect,lAutoexec,oWnd
Return Self

METHOD Save() CLASS TSalPrinterXLS

MsgRun( "Generando Arquivo Excel.... espere ", , {|| ::Stabilize() } )

SET XLS TO DISPLAY ;
OF ::oXLS

::oXLS:End()

RETURN Self

METHOD Stabilize() CLASS TSalPrinterXLS



RETURN Nil

METHOD Say( nCol, xText, nFont, nPad, nRow, cPicture ) CLASS TSalPrinterXLS

LOCAL uVal, ;
nAlignamen := 0, ;
nFormat := 0

DEFAULT xText := '', ;
nFont := 1, ;
nPad := RPT_LEFT

// nFont:= ::cFont( nFont )

DO CASE
CASE nPad == RPT_LEFT
nAlignament := ALING_LEFT

CASE nPad == RPT_RIGHT
nAlignament := ALING_RIGHT

CASE nPad == RPT_CENTER
nAlignament := ALING_CENTER
ENDCASE

// IF !empty( cPicture )
// nFormat := 0 // ::cFormat( cPicture, valtype( xText ) )
// ENDIF
LineadeStatus(Str(nRow)+"--"+str(nCol)+"->"+Alltrim(xText)+Str(nFont),4)
@ nRow, nCol XLS SAY xText OF ::oXLS ;
FONT nFont ; // FORMAT nFormat ;
ALIGNAMENT nAlignament

Return Nil

Es todo

Manuel J. Morales Q.
Lima Perú