vfp Exportar a Excel

FUNCTION rep_excel(lcursor AS STRING, lnombre AS STRING)
  *!*       Parametros:
  *!*      lcursor: Nombre del Cursor o Tabla que se va a llevar a excel
  *!*      lnombre: El titulo de la pagina

  ************************************
  *!* Program:Rep_excel
  *!* Author: José G. Samper
  *!* Date: 10/09/03 04:08:04 PM
  *!* Copyright: NetBuzo's
  *!* Description: Esta función lleva a una hoja excel el contenido de un cursor
  *!* Colocando un Nombre pasado como parametro y los nombres de los campos del cursor como encabezado
  *!* Revision Information:1.0
  *!* Ejemplo de Uso: =rep_excel('mitabla','Listado de Artículos con sus Precios')
  *!* Enviar Bugs o sugerencias para mejoras a j_samper(sin)@cantv.net
  *************************************
  IF TYPE('lcursor')#'C' OR !USED(lcursor)
    =MESSAGEBOX("Parametros Invalidos",16,'De VFP a Excel')
    RETURN .F.
  ENDIF
  IF TYPE('lnombre')#'C'
    lnombre=''
  ENDIF
  LOCAL lpag AS INTEGER &&&&variable para determinar la página a ingresar los datos por si hay más de 60 mil registros
  lpag=1
  *** Creación del Objeto Excel
  WAIT WINDOW 'Abriendo aplicación Excel.' NOWAIT
  Oexcel = CREATEOBJECT("Excel.Application")
  WAIT CLEAR
  IF TYPE('Oexcel')#'O'
    =MESSAGEBOX("No se puede procesar el archivo porque no tiene la aplicación"+CHR(13)+;
      "Microsoft Excel instalada en su computador.",16,'De VFP a Excel')
    RETURN .F.
  ENDIF
  WAIT WINDOWS 'Procesando Tabla...'+LOWER(lcursor) NOCLEAR NOWAIT
  XLApp = Oexcel
  XLApp.workbooks.ADD()
  XLSheet = XLApp.ActiveSheet
  XLSheet.NAME='VFP_'+ALLTR(STR(lpag))
  SELECT(lcursor)
  lcuantos=AFIELDS(lcampos,lcursor)
  GO TOP IN (lcursor)
  LOCAL R,lcampo
  R=6
  SCAN
    IF R= 65500
      FOR I = 1 TO lcuantos
        lcname=lcampos(I,1)
        XLSheet.Cells(4,I).VALUE=lcname
        XLSheet.Cells(4,I).FONT.NAME = "Arial"
        XLSheet.Cells(4,I).FONT.SIZE = 10
        XLSheet.Cells(4,I).FONT.bold = .T.
      NEXT
      XLSheet.COLUMNS.AUTOFIT
      XLSheet.Cells(2,1).VALUE=lnombre
      XLSheet.Cells(2,1).FONT.bold = .T.
      XLSheet.Cells(1,1).VALUE='Paginas Marcadas...'
      XLSheet.Cells(1,1).FONT.bold = .T.
      XLSheet.Cells(1,IIF((lcuantos-1)>0,lcuantos-1,lcuantos)).VALUE=ALLTRIM(DTOC(DATE()))
      XLSheet.COLUMNS.AUTOFIT
      R=6
      lpag=lpag+1
      XLApp.Sheets(lpag).SELECT
      XLSheet = XLApp.ActiveSheet
      XLSheet.NAME='VFP_'+ALLTR(STR(lpag))
    ENDIF
    FOR I=1 TO lcuantos
      lcampo=ALLTRIM(lcursor)+'.'+lcampos(I,1)
      IF TYPE('&lcampo')#'G'
        IF TYPE('&lcampo')='C'
          XLSheet.Cells(R,I).VALUE=ALLTRIM(&lcampo)
          XLSheet.Cells(R,I).FONT.NAME = "Arial"
          XLSheet.Cells(R,I).FONT.SIZE = 10
        ELSE
          IF TYPE('&lcampo')='T'
            XLSheet.Cells(R,I).VALUE=TTOC(&lcampo)
          ELSE
            XLSheet.Cells(R,I).VALUE=&lcampo
          ENDIF
          XLSheet.Cells(R,I).FONT.NAME = "Arial"
          XLSheet.Cells(R,I).FONT.SIZE = 10
        ENDIF
      ENDIF
    NEXT
    R=R+1
  ENDSCAN
  FOR I = 1 TO lcuantos
    lcname=lcampos(I,1)
    XLSheet.Cells(4,I).VALUE=lcname
    XLSheet.Cells(4,I).FONT.NAME = "Arial"
    XLSheet.Cells(4,I).FONT.SIZE = 10
    XLSheet.Cells(4,I).FONT.bold = .T.
  NEXT
  XLSheet.COLUMNS.AUTOFIT
  XLSheet.Cells(2,1).VALUE=lnombre
  XLSheet.Cells(2,1).FONT.bold = .T.
  XLSheet.Cells(1,1).VALUE='Demostración de Vfp a Excel'
  XLSheet.Cells(1,1).FONT.bold = .T.
  XLSheet.Cells(1,IIF((lcuantos-1)>0,lcuantos-1,lcuantos)).VALUE=ALLTRIM(DTOC(DATE()))
  XLSheet.COLUMNS.AUTOFIT
  WAIT WINDOWS 'Listo....' NOWAIT
  Oexcel.VISIBLE=.T.
  RETURN .T.
ENDFUNC