Cómo marcar los bordes de un rango de celdas en excel desde FoxPro 9.0

[Rafael Morales]

Hola, he agregado a mi aplicación una hrramienta que le permite al usuario exportar los datos de un cursor a un archivo de Excel, el archivo se exporta perfectamente, el problema es que deseo marcar los bordes de las celdas que contienen los datos pero no sé como hacerlo desde Foxpro. He intentado con lo siguiente:

x=1
y=1
do while x<=10
y=1
do while y<=10
ExcObj.cells(x,y).Borders(1).LineStyle=1
ExcObj.cells(x,y).Borders(2).LineStyle=1
ExcObj.cells(x,y).Borders(3).LineStyle=1
ExcObj.cells(x,y).Borders(4).LineStyle=1

y=y+1
enddo
x=x+1
enddo

Esto logra marcar los bordes como quiero pero el problema es que demora 2 minutos en realizarlo. Alguien conoce alguna forma mas rápida de lograrlo?. Gracias.
--
Rafael

[Mauricio Ruben Molinero]

Hola Rafael!

Debes tener otra cosa, este codigo demora 2.92 segundos en ejecutar!

Windows 7, Office 2010

Saludos!

Mauricio R. Molinero,

 

lnStart = SECONDS()

ExcObj=CREATEOBJECT("Excel.application")

ExcObj.APPLICATION.VISIBLE = .T.

ExcObj.APPLICATION.workbooks.ADD

x=1

y=1

do while x<=10

y=1

do while y<=10

ExcObj.cells(x,y).Borders(1).LineStyle=1

ExcObj.cells(x,y).Borders(2).LineStyle=1

ExcObj.cells(x,y).Borders(3).LineStyle=1

ExcObj.cells(x,y).Borders(4).LineStyle=1

y=y+1

enddo

x=x+1

ENDDO

? SECONDS() - lnStart 

[Mauricio Ruben Molinero]

Sin el "visible", 1.72

Saludos!

[TheNewInquirer]

Y como se podría mandar por codigo un reporte con encabezado y pie de
pagina y margenes hasta excel?...

[Walter R. Ojeda Valiente]

No sé si servirá para tu caso pero lo que yo hago es lo siguiente:

- Creo un "modelo" de planilla Excel, con todos los títulos, colores, bordes, etc.
- Mi programa copia el modelo a otro archivo. Por ejemplo:
    COPY FILE MODELO1.XLS TO PLANILLA1.XLS
- Abro PLANILLA1.XLS
- Relleno las celdas de PLANILLA1.XLS

Así, programo mucho menos en VFP y me aseguro que la presentación visual sea la que yo quiero.

Saludos.

Walter.

---

Date: Thu, 29 Mar 2012 16:07:55 -0300
Subject: [vfp] Cómo marcar los bordes de un rango de celdas en excel desde FoxPro 9.0
From: rafam...@gmail.com
To: publice...@googlegroups.com

[Jairo]

Mira aquí..

http://www.luismariaguayan.com.ar/articulos.htm

JM

-----Mensaje original-----
De: publice...@googlegroups.com
[mailto:publice...@googlegroups.com] En nombre de TheNewInquirer
Enviado el: jueves, 29 de marzo de 2012 03:09 p.m.
Para: Comunidad de Visual Foxpro en Español
Asunto: SPAM-LOW: [vfp] Re: Cómo marcar los bordes de un rango de celdas en
excel desde FoxPro 9.0

Y como se podría mandar por codigo un reporte con encabezado y pie de

[Rafael Morales]

Gracias a todos por responder. Ya he solucionado el problema, estuve buscando en internet y encontré un tutorial que está buenisimo aqui les dejo el links por si alguno quiere verlo

http://www.programatium.com/vfox/tutoriales/automatizar-excel-con-vfox.htm

de esa página saque lo siguiente:

WITH XLSheet.Range("A4:Q4")
            .Borders(xlDiagonalDown).LineStyle = xlNone
            .Borders(xlDiagonalUp).LineStyle = xlNone
            .Borders(xlEdgeLeft).LineStyle = xlNone
            .Borders(xlEdgeTop).LineStyle = xlNone
            .Borders(xlEdgeRight).LineStyle = xlNone
            .Borders(xlInsideVertical).LineStyle = xlContinuous
            .Borders(xlInsideVertical).Weight = xlThin
            .Borders(xlInsideVertical).ColorIndex = xlAutomatic
ENDWITH

Luego lo puse en mi programa y le hice algunas modificaciones y quedó asi:

  WITH XLSheet.RANGE(XLSheet.Cells(xregistros),XLSheet.Cells(xcolumnas))
     .Borders(1).LineStyle = 1
     .Borders(2).LineStyle = 1
     .Borders(3).LineStyle = 1
     .Borders(4).LineStyle = 1
     .Borders(1).LineStyle = 1
     .Borders(2).LineStyle = 1
     .Borders(3).Weight = 1
     .Borders(4).ColorIndex = 1
  ENDWITH

y listo, esto solucionó el problema ahora solo tarda 3 segundos en marcar los bordes de las celdas en excel.

Saludos...

[Rafael Morales]

y aqui les dejo tambien una rutina que permite exportar cualquier cursor o tabla a Excel. lo encotré en portalfox y esta buenisima. Este es el link:

http://www.portalfox.com/index.php?name=News&file=article&sid=2243&mode=nested&order=0&thold=0

Estas son las lineas de código:

********************************************************************
********************************************************************
*!* FUNCTION Exp2Excel( [cCursor, [cFileSave, [cTitulo]]] )
*!*
*!* Exporta un Cursor de Visual FoxPro a Excel, utilizando la
*!* técnica de importación de datos externos en modo texto.
*!*
*!* PARAMETROS OPCIONALES:
*!* - cCursor  Alias del cursor que se va a exportar.
*!*            Si no se informa, utiliza el alias
*!*            en que se encuentra.
*!*
*!* - cFileName  Nombre del archivo que se va a grabar.
*!*              Si no se informa, muestra el libro generado
*!*              una vez concluída la exportación.
*!*
*!* - cTitulo  Titulo del informe. Si se informa, este
*!*            ocuparía la primera file de cada hoja del libro.
********************************************************************
********************************************************************
FUNCTION Exp2Excel( cCursor, cFileSave, cTitulo )
  LOCAL cWarning
  cWarning = "Exportar a EXCEL"
  IF EMPTY(cCursor)
    cCursor = ALIAS()
  ENDIF
  IF TYPE('cCursor') # 'C' OR !USED(cCursor)
    MESSAGEBOX("Parámetros Inválidos",16,cWarning)
    RETURN .F.
  ENDIF
  *********************************
  *** Creación del Objeto Excel ***
  *********************************
  WAIT WINDOW 'Abriendo aplicación Excel.' NOWAIT NOCLEAR
  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,cWarning)
    RETURN .F.
  ENDIF

  oExcel.workbooks.ADD

  LOCAL lnRecno, lnPos, lnPag, lnCuantos, lnRowTit, lnRowPos, i, lnHojas, cDefault

  cDefault = ADDBS(SYS(5)  + SYS(2003))

  SELECT (cCursor)
  lnRecno = RECNO(cCursor)
  GO TOP

  *************************************************
  *** Verifica la cantidad de hojas necesarias  ***
  *** en el libro para la cantidad de datos     ***
  *************************************************
  lnHojas = ROUND(RECCOUNT(cCursor)/65000,0)
  DO WHILE oExcel.Sheets.COUNT < lnHojas
    oExcel.Sheets.ADD
  ENDDO

  lnPos = 0
  lnPag = 0

  DO WHILE lnPos < RECCOUNT(cCursor)

    lnPag = lnPag + 1 && Hoja que se está procesando

    WAIT WINDOWS 'Exportando cursor '  + UPPER(cCursor)  + ' a Microsoft Excel...' ;
      + CHR(13) + '(Hoja '  + ALLTRIM(STR(lnPag))  + ' de '  + ALLTRIM(STR(lnHojas)) ;
      + ')' NOCLEAR NOWAIT

    IF FILE(cDefault  + cCursor  + ".txt")
      DELETE FILE (cDefault  + cCursor  + ".txt")
    ENDIF

    COPY  NEXT 65000 TO (cDefault  + cCursor  + ".txt") DELIMITED WITH CHARACTER ";"
    lnPos = RECNO(cCursor)

    oExcel.Sheets(lnPag).SELECT

    XLSheet = oExcel.ActiveSheet
    XLSheet.NAME = cCursor + '_' + ALLTRIM(STR(lnPag))

    lnCuantos = AFIELDS(aCampos,cCursor)

    ********************************************************
    *** Coloca título del informe (si este es informado) ***
    ********************************************************
    IF !EMPTY(cTitulo)
      XLSheet.Cells(1,1).FONT.NAME = "Arial"
      XLSheet.Cells(1,1).FONT.SIZE = 12
      XLSheet.Cells(1,1).FONT.BOLD = .T.
      XLSheet.Cells(1,1).VALUE = cTitulo
      XLSheet.RANGE(XLSheet.Cells(1,1),XLSheet.Cells(1,lnCuantos)).MergeCells = .T.
      XLSheet.RANGE(XLSheet.Cells(1,1),XLSheet.Cells(1,lnCuantos)).Merge
      XLSheet.RANGE(XLSheet.Cells(1,1),XLSheet.Cells(1,lnCuantos)).HorizontalAlignment = 3
      lnRowPos = 3
    ELSE
      lnRowPos = 2
    ENDIF

    lnRowTit = lnRowPos - 1
    **********************************
    *** Coloca títulos de Columnas ***
    **********************************
    FOR i = 1 TO lnCuantos
      lcName  = aCampos(i,1)
      lcCampo = ALLTRIM(cCursor) + '.' + aCampos(i,1)
      XLSheet.Cells(lnRowTit,i).VALUE=lcname
      XLSheet.Cells(lnRowTit,i).FONT.bold = .T.
      XLSheet.Cells(lnRowTit,i).Interior.ColorIndex = 15
      XLSheet.Cells(lnRowTit,i).Interior.PATTERN = 1
      XLSheet.RANGE(XLSheet.Cells(lnRowTit,i),XLSheet.Cells(lnRowTit,i)).BorderAround(7)
    NEXT

    XLSheet.RANGE(XLSheet.Cells(lnRowTit,1),XLSheet.Cells(lnRowTit,lnCuantos)).HorizontalAlignment = 3

    *************************
    *** Cuerpo de la hoja ***
    *************************
    oConnection = XLSheet.QueryTables.ADD("TEXT;"  + cDefault  + cCursor  + ".txt", ;
      XLSheet.RANGE("A"  + ALLTRIM(STR(lnRowPos))))

    WITH oConnection
      .NAME = cCursor
      .FieldNames = .T.
      .RowNumbers = .F.
      .FillAdjacentFormulas = .F.
      .PreserveFormatting = .T.
      .RefreshOnFileOpen = .F.
      .RefreshStyle = 1 && xlInsertDeleteCells
      .SavePassword = .F.
      .SaveData = .T.
      .AdjustColumnWidth = .T.
      .RefreshPeriod = 0
      .TextFilePromptOnRefresh = .F.
      .TextFilePlatform = 850
      .TextFileStartRow = 1
      .TextFileParseType = 1 && xlDelimited
      .TextFileTextQualifier = 1 && xlTextQualifierDoubleQuote
      .TextFileConsecutiveDelimiter = .F.
      .TextFileTabDelimiter = .F.
      .TextFileSemicolonDelimiter = .T.
      .TextFileCommaDelimiter = .F.
      .TextFileSpaceDelimiter = .F.
      .TextFileTrailingMinusNumbers = .T.
      .REFRESH
    ENDWITH

    XLSheet.RANGE(XLSheet.Cells(lnRowTit,1),XLSheet.Cells(XLSheet.ROWS.COUNT,lnCuantos)).FONT.NAME = "Arial"
    XLSheet.RANGE(XLSheet.Cells(lnRowTit,1),XLSheet.Cells(XLSheet.ROWS.COUNT,lnCuantos)).FONT.SIZE = 8

    XLSheet.COLUMNS.AUTOFIT
    XLSheet.Cells(lnRowPos,1).SELECT
    oExcel.ActiveWindow.FreezePanes = .T.

    WAIT CLEAR

  ENDDO

  oExcel.Sheets(1).SELECT
  oExcel.Cells(lnRowPos,1).SELECT

  IF !EMPTY(cFileSave)
    oExcel.DisplayAlerts = .F.
    oExcel.ActiveWorkbook.SAVEAS(cFileSave)
    oExcel.QUIT
  ELSE
    oExcel.VISIBLE = .T.
  ENDIF

  GO lnRecno

  RELEASE oExcel,XLSheet,oConnection

  IF FILE(cDefault + cCursor + ".txt")
    DELETE FILE (cDefault + cCursor + ".txt")
  ENDIF

  RETURN .T.

ENDFUNC

***
***