6 de abril de 2016

Crear una hoja de Excel con SubTotales

Con el siguiente código y utilizando Automation, podemos crear una hoja Excel con SubTotales. Cortesía de Çetin Basöz, MVP de VFP.

OPEN DATABASE (HOME(2) + "Northwind\Northwind.dbc")
SELECT o.CustomerId, o.OrderId, ProductId, UnitPrice, Quantity ;
  FROM Orders o inner JOIN OrderDetails od ON o.OrderId = od.OrderId ;
  ORDER BY o.CustomerId, o.OrderId ;
  INTO CURSOR crsTemp
lcXLSFile = SYS(5) + CURDIR() + "myOrders1.xls"
COPY TO (lcXLSFile) TYPE XLS
CLOSE DATABASES ALL
DIMENSION laSubtotal[3]
laSubtotal[1] = 4 && Unit_price
laSubtotal[2] = 5 && Quantity
laSubtotal[3] = 6 && Will use later
#DEFINE xlSum -4157
oExcel = CREATEOBJECT("excel.application")
WITH oExcel
  .Workbooks.OPEN(lcXLSFile)
  WITH .ActiveWorkbook.ActiveSheet
    lnRows = .UsedRange.ROWS.COUNT && Get current row count
    lcFirstUnusedColumn = _GetChar(laSubtotal[3]) && Get column in Excel A1 notation
    * Instead of orders order_net field use Excel calculation for net prices
    .RANGE(lcFirstUnusedColumn + '2:' + ;
      lcFirstUnusedColumn + TRANSFORM(lnRows)).FormulaR1C1 = ;
      "=RC[-2]*RC[-1]"
    .RANGE(lcFirstUnusedColumn+'1').VALUE = 'Extended Price' && Place header
    .RANGE('D:'+lcFirstUnusedColumn).NumberFormat = "$#,##0.0000" && Format columns
    * Subtotal grouping by customer then by order
    .UsedRange.Subtotal(1, xlSum, @laSubtotal)
    .UsedRange.Subtotal(2, xlSum, @laSubtotal,.F.,.F.,.F.)
    .UsedRange.COLUMNS.AUTOFIT && Autofit columns
  ENDWITH
  .VISIBLE = .T.
ENDWITH
* Return A, AA, BC etc notation for nth column
FUNCTION _GetChar
  LPARAMETERS tnColumn && Convert tnValue to Excel alpha notation
  IF tnColumn = 0
    RETURN ""
  ENDIF
  IF tnColumn <= 26
    RETURN CHR(ASC("A") - 1 + tnColumn)
  ELSE
    RETURN  _GetChar(INT(IIF(tnColumn % 26 = 0, tnColumn - 1, tnColumn) / 26)) + ;
      _GetChar((tnColumn-1) % 26 + 1)
  ENDIF
ENDFUNC

Çetin Basöz
MS Foxpro MVP, MCP

No hay comentarios. :

Publicar un comentario