Clase TExcels con Tablas Dinámicas

[Cgallegoa]

Hola compañeros, un cordial saludo a los tiempos.

Estoy necesitando urgente la clase TExcels modificada por Carlos Sincuir y Julio Ponce para generar Tablas Dinámicas en Excel desde FWH.

Los links que hay en el foro para descargarla están desactivados. así que pido a algún compañero bondadoso que la tenga, me regale una copia.

Un abrazo y gracias anticipadas.

[csincuir]

Carlos,
Esta es la clase TExcels que utilizo:
(Los cambios que yo hice a esta clase estan marcados como [CSR])

Code: Select all  Expand view

/*
 * Clase TExcelScript v1.8 26/08/2002
 *
 * Esta Clase usa la Libreria Ole2 de José F. Giménez
 *
 * Esta clase esta desarrollada gracias a todos los aportes del foro de FiveWin
 * Aunque no esta terminada , es totalmente funcional.
 *
 * Autor: Víctor Manuel Tomas Díaz [Viktor]
 *
 * Modificaciones y agregados realizadas por:
 * Daniel Andrade - [AD2K] 26/08/2002
 * Rimantas Usevicius - [RimUs] 25-09-2002
 * Carlos Sincur Romero - [CSR] 4/9/2002
 * El Browse es un concepto original de René Flores , adaptado a esta clase.
 *
 */

#include "FiveWin.ch"

/*
 *  TExcelScript()
 */
CLASS TExcelScript

  DATA oExcel
  DATA oBook
  DATA oSheet
  DATA oCell
  DATA oFind
  DATA oClip
  DATA oPivot

  DATA cFile
  DATA cFont
  DATA cAlias

  DATA nAt
  DATA nSize
  DATA nAlign

  DATA lBold
  DATA lItalic
  DATA lUnderLine
  DATA lDefault   AS LOGICAL    INIT .T.
  DATA lExcel

  DATA aExcelCols AS ARRAY INIT {}
  DATA aData      AS ARRAY INIT {}


  METHOD New()
  METHOD Open( cFilexls )
  METHOD Create( cFilexls )
  METHOD Get( nRow , nCol ,cValue )
  METHOD Say( nRow, nCol, xValue, cFont, nSize, lBold, lItalic, ;
              lUnderLine, nAlign, nColor, nFondo )

  METHOD CellFormat( nRow, nCol, nBackGround, nLine, cFormat )
  METHOD Borders( cRange, nRow, nCol, nStyle )
  METHOD GetCell()          INLINE (::oCell := ::oExcel:Get( "ActiveCell" ), ::oCell)
  METHOD Visualizar(lValue) INLINE ::oExcel:Visible := lValue
  METHOD AutoFit( nCol )    INLINE ::oSheet:Columns( nCol ):AutoFit()
  METHOD Save()             INLINE ::oSheet:SaveAs( ::cFile )         // ::oBook:Save()
  METHOD SaveAs( cFilexls ) INLINE ::oSheet:SaveAs( cFilexls )

  METHOD Print()
  METHOD SetFont(cFont)     INLINE ::oSheet:Cells:Font:Name := cFont
  METHOD SizeFont(nSize)    INLINE ::oSheet:Cells:Font:Size := 12
  METHOD Font(cFont)        INLINE ::cFont := cFont
  METHOD Size(nSize)        INLINE ::nSize := nSize
  METHOD Align(nPos)        INLINE ::nAlign := nPos
  METHOD AddCol( bAction , nAlign , bClrText , bClrPane , bHeading , bFooting )
  METHOD Browse( nRow , nCol , cAlias , cFont , nSize , bClrText , bClrPane  )
  METHOD SetArray(aArray)   INLINE ::aData := aArray

  METHOD ISaltoPagina()    INLINE ::oSheet:HPageBreaks:Invoke("Add", ::oCell )  

  /*
   * Metodos para las propiedades de la hoja
   */
  METHOD AddSheet()         INLINE ::oExcel:Sheets:Add()
  METHOD CopySheet()        INLINE  ::oExcel:Sheets:Copy()
  METHOD DelSheet(cSheet)   INLINE ::oExcel:Sheets(cSheet):Delete()

  // cPos -> "After" | "Before"
  METHOD MoveSheet(cSheet,cPos,nSheet)  //INLINE ::oExcel:Sheets(cSheet):Move(cPos,nSheet)
  METHOD SetSheet(cSheet)               INLINE ::oExcel:Sheets(cSheet):Select() , ::oSheet := ::oExcel:Get( "ActiveSheet" )
  METHOD NameSheet(cSheet,cName)        INLINE ::oExcel:Sheets(cSheet):Name := cName
  METHOD MultiLine(nRow , nCol )        INLINE ::oSheet:Cells( nRow, nCol ):Set("WrapText",.T.)
  METHOD RanMultiLine( cRange )         INLINE ::oSheet:Range( cRange ):Set("WrapText",.T.)
  METHOD AddComent( nRow, nCol, cText )
  METHOD Combinar( cRange )             //INLINE ::oSheet:Range( cRange ):Merge()
  METHOD RangeFondo( cRange, nColor )
  METHOD RangeColorFont( cRange, nColor )
  METHOD ColumnWidth( nCol, nWidth )  //Modificaco CSR  //INLINE ::oSheet:Columns( nCol ):Set("ColumnWidth",Alltrim(Str(nWidth)))
  METHOD Subtotal(cRange, nGroup, nOpe, nCol)
  METHOD AutoFilter(cRange, nCol, uVal) INLINE ::oSheet:Range( cRange ):AutoFilter(nCol,uVal)
  METHOD Filter(cRange) INLINE ::oSheet:Range( cRange ):AutoFilter()
  METHOD GroupTot(cRange,nGroup,nFuncion,aTotal) INLINE ::oSheet:Range( cRange ):SubTotal(nGroup,nFuncion,aTotal,.t.,.f.,.t.)
  METHOD End( lClose )

  // ***** Agregados[AD2K] *******
  MESSAGE Eval()                METHOD eEval( cCommand, lOemAnsi )

  METHOD SetPos( cRange )     INLINE ( iif( ::lExcel, (::oSheet:Range( cRange ):Select(), ::GetCell()), ) )
  METHOD InsertRow( cRange )  INLINE (iif( cRange != NIL, ::SetPos( cRange ),), ::GetCell():EntireRow():Insert())
  METHOD InsertCol( cRange )  INLINE (iif( cRange != NIL, ::SetPos( cRange ),), ::GetCell():Get("EntireColumn"):Insert())

  METHOD Find( cSearch, lMatch, lPart )
  METHOD FindNext()
  METHOD Replace( cSearch, cReplace, lMatch, lPart, lAll, lFull, cFormat )

  METHOD Duplicate( cRange )
  MESSAGE Clear()             METHOD eClear( cRange )
  // *****************************

  METHOD Chart( cRange , cTitle , nType, nDepth , nGapDepth, nLoc, cHoja  ) //  [RimUs]

  // ****** Agregados [CSR] ******
  METHOD Picture( cFile, cRange )  INLINE (iif( cRange != NIL, ::SetPos(cRange ),), ::oSheet:Pictures:insert(cFile) )
  METHOD SetLandScape()      INLINE ::oSheet:PageSetup:Set("Orientation",2 )
  METHOD SetPortrait()       INLINE ::oSheet:PageSetup:Set("Orientation",1 )
  METHOD Copy( cRange )
  METHOD Paste()
  //***Nuevos
  METHOD RanFontBold( cRange, nRow, nColr )   //INLINE ::oSheet:Range( cRange ):Font:Bold := .T.
  METHOD RanAlin( cRange, nAli )   INLINE ::oSheet:Range( cRange ):Set("HorizontalAlignment",Alltrim(Str(nAli)))
  METHOD Run()
  METHOD Bordersl( cRange, nRow, nCol, nS1, nS2, nS3, nS4 )
  METHOD Bordersw( cRange, nRow, nCol, nS1, nS2, nS3, nS4 )
  METHOD BordersSubTot( cRange, nRow, nCol )
  METHOD Add( cFilexls )
  METHOD CloseBook()
  METHOD Guardar()
  METHOD Autoformat( cRange, nFormat )   INLINE ::oSheet:Range( cRange ):Autoformat( nFormat, .t.,.t.,.f. )
  METHOD Formula(cPos,cFormula) //INLINE ( ::SetPos( cPos ), ::oSheet:Range( cPos ):Formula := cFormula )
  METHOD FreezePanel( cRange )
  METHOD Zoom(nZoom)
  METHOD FormatoNumerico( cRango, cFormato )

  //***TablasDinamicas [CSR]
  METHOD TablaDinamica( cRango )
  METHOD SetRowTD( cRow )
  METHOD SetColumnTD( cCol )
  METHOD SetPageTD( cPage )
  METHOD SetDataTD( cData )
  METHOD SetFormatTD( nFormato )
  METHOD TablaFteExt( cConnStr, cQuery )  //[JAAM]

  //oSheet:Range( <spec> ):Select()
///oExcel:Selection:ClearContents()
//oExcel:Selection:ClearFormats()

 
  // *****************************

ENDCLASS

/*
 *  TExcelScript():New()
 */
METHOD New() CLASS TExcelScript

//  ::oExcel := CreateObject( "Excel.Application" ) //TOleAuto():New("Excel.Application")

    ::lExcel := .T.

      TRY
        ::oExcel := GetActiveObject( "Excel.Application" )
        ::oClip:=TClipBoard():New()
        ::oClip:Clear()
      CATCH
         TRY
            ::oExcel := CreateObject( "Excel.Application" )
            ::oClip:=TClipBoard():New()
            ::oClip:Clear()
         CATCH
            //Alert( "No está Excel Instalado en está Pc." )
            ::lExcel := .f.
         END
      END
      ::aExcelCols := {}
RETURN( Self )

 
RETURN Self

/*
 *  TExcelScript():Open()
 */
METHOD Open( cFilexls )  CLASS TExcelScript

  If !File( cFileXls )
     MsgAlert( cFileXls+CRLF+"No Encontrado...!!","Error..." )
     Return NIL
  End
  If !::lExcel
  //Msginfo( "start "+cFilexls )
     WinExec( "START "+cFilexls )
     Return .t.
  End
 
  ::cFile := cFilexls
  ::oBook := ::oExcel:WorkBooks:Open( ::cFile )   //::oExcel:WorkBooks:Open( ::cFile )

/*
    FOR i = 1 TO ::oBook:WorkSheets:Count
        ? ::oBook:WorkSheets( i ):Name
    NEXT
*/  

//  ::oBook       := ::oExcel:Get( "ActiveWorkBook")
  ::oSheet      := ::oExcel:Get( "ActiveSheet" )
  ::cFont       := "Arial"
  ::nSize       := 10
  ::lBold       := .F.
  ::lItalic     := .F.
  ::lUnderLine  := .F.
  ::nAlign      := 1
  ::lDefault    := .F.

  ::SetPos("A1")
  ::GetCell()

RETURN Self


/*
 *  TExcelScript():Create()
 */
METHOD Create( cFilexls )  CLASS TExcelScript

  ::cFile := cFilexls
  ::oExcel:WorkBooks:Add()

  ::oBook       := ::oExcel:Get( "ActiveWorkBook")
  ::oSheet      := ::oExcel:Get( "ActiveSheet" )
  ::cFont       := "Arial"
  ::nSize       := 10
  ::lBold       := .F.
  ::lItalic     := .F.
  ::lUnderLine  := .F.
  ::nAlign      := 1
  ::lDefault    := .T.

  ::SetPos("A1")
  ::GetCell()

RETURN Self

/*
 *  TExcelScript():Get()
 */
METHOD Get( nRow, nCol, cValue )  CLASS TExcelScript

  local xVret, cType

  DEFAULT cValue  := NIL
  If !::lExcel
     Return .f.
  End

  if nRow == NIL .or. nCol == NIL
    ::GetCell()
    DEFAULT nRow  := ::oCell:Row
    DEFAULT nCol  := ::oCell:Column
  endif

  xVret := ::oSheet:Cells( nRow, nCol ):Value
  xVret := IIF( ValType( xVret )=="U", "" , xVret )
  cType := ValType( xVret )

  IF cValue != NIL
    IF cValue == "N"
      xVret := IIF( ValType( xVret )=="C", Val(xVret) ,;
               IIF( ValType( xVret )=="D", xVret, xVret )  )
    ENDIF
    IF cValue == "C"
      xVret := IIF( ValType( xVret )=="N", Ltrim(Str(xVret) ),;
               IIF( ValType( xVret )=="D", Dtos(xVret), xVret )  )
    ENDIF
  ENDIF

RETURN xVret

/*
 *  TExcelScript():RangeFondo()
 */
METHOD RangeFondo( cRange, nColor, nRow, nCol )  CLASS TExcelScript

  DEFAULT cRange := "", nColor := Rgb(255 , 255 , 255 ), nRow := ::oCell:Row, nCol := ::oCell:Column
  If !::lExcel
     Return .f.
  End
 
  If !Empty( cRange )
     ::oSheet:Range( cRange ):Interior:Color := nColor
  Else
     ::oSheet:Cells( nRow, nCol ):Interior:Color := nColor
  End

RETURN Self


/*
 *  TExcelScript():RangeColorFont()
 */
METHOD RangeColorFont( cRange, nColor, nRow, nCol )  CLASS TExcelScript

  DEFAULT cRange := "", nColor := Rgb(0 , 0 , 0 ), nRow := ::oCell:Row, nCol := ::oCell:Column

  If !::lExcel
     Return .f.
  End
 
  If !Empty( cRange )
     ::oSheet:Range( cRange ):Font:Color := nColor
  Else
    ::oSheet:Cells( nRow, nCol ):Font:Color := nColor
  End

RETURN Self

/*
 *  TExcelScript():Borders()
 */
METHOD Borders( cRange , nRow , nCol , nStyle )  CLASS TExcelScript

  DEFAULT nStyle := 1, cRange := ""
  If !::lExcel
     Return .f.
  End

  if Empty( cRange )
    ::oSheet:Cells( nRow, nCol ):Borders():LineStyle  := nStyle
  else
    ::oSheet:Range( cRange ):Borders():LineStyle  := nStyle
  endif

RETURN Self

/*
 *  TExcelScript():CellFormat()
 */
METHOD CellFormat( cFormat, nRow, nCol, nColor, nLine )  CLASS TExcelScript

  If !::lExcel
     Return .t.
  End
 
  if nRow == NIL .or. nCol == NIL
    ::GetCell()
    DEFAULT nRow  := ::oCell:Row
    DEFAULT nCol  := ::oCell:Column
  endif

  if ::lDefault
    DEFAULT nColor := Rgb(255 , 255 , 255 )
  endif

  if nColor != NIL
    ::oSheet:Cells( nRow, nCol ):Interior:Color := nColor
  endif

  if cFormat != NIL
    ::oSheet:Cells( nRow, nCol ):Set("NumberFormat",cFormat)
  endif

  //::oSheet:Cells( nRow, nCol ):Interior:Pattern := 2
  //::oSheet:Cells( nRow, nCol ):Borders(nLine):LineStyle  := 1  // Bottom
 
RETURN Self

/*
 *  TExcelScript():AddComent()
 */
METHOD AddComent( nRow , nCol , cText )  CLASS TExcelScript

  DEFAULT cText := ""
  If !::lExcel
     Return .f.
  End
 
  IF !Empty( cText )
    ::oSheet:Cells( nRow, nCol ):AddComment(cText)
  ENDIF

RETURN Self

/*
 *  TExcelScript():Print()
 */
METHOD Print()   CLASS TExcelScript

  ::oSheet:PrintOut()
 
RETURN Self

/*
 *  TExcelScript():Say()
 */
METHOD Say( nRow, nCol, xValue, cFont, nSize, lBold, lItalic, ;
            lUnderLine, nAlign, nColor, nFondo )  CLASS TExcelScript
  * nAlign -> 1  // Derecha
  * nAlign -> 4  // Izquierda
  * nAlign -> 7  // Centrado
 
  local xVret

  If !::lExcel
     Return .f.
  End
 
  If ValType( xValue ) != "C"
     Return .f.
  End
 
  if ::lDefault
    DEFAULT cFont       := ::cFont
    DEFAULT nSize       := ::nSize
    DEFAULT lBold       := ::lBold
    DEFAULT lItalic     := ::lItalic
    DEFAULT lUnderLine  := ::lUnderLine
    DEFAULT nAlign      := ::nAlign
    DEFAULT nColor      := Rgb( 0 , 0 , 0)
    DEFAULT nFondo      := RGB( 255, 255, 255 )
  endif

  if nRow == NIL .or. nCol == NIL
    ::GetCell()
    DEFAULT nRow  := ::oCell:Row
    DEFAULT nCol  := ::oCell:Column
  endif

  if cFont != NIL
    ::oSheet:Cells( nRow, nCol ):Font:Name := cFont
  endif

  if nSize != NIL
    ::oSheet:Cells( nRow, nCol ):Font:Size := nSize
  endif

  if lBold != NIL
    ::oSheet:Cells( nRow, nCol ):Font:Bold := lBold
  endif

  if lItalic != NIL
    ::oSheet:Cells( nRow, nCol ):Font:Italic := lItalic
  endif

  if lUnderLine != NIL
    ::oSheet:Cells( nRow, nCol ):Font:UnderLine := lUnderLine
  endif

  if nColor != NIL
    ::oSheet:Cells( nRow, nCol ):Font:Color := nColor
  endif

  ::oSheet:Cells( nRow, nCol ):Value := xValue

  if nFondo != NIL
    ::oSheet:Cells( nRow, nCol ):Interior:Color := nFondo
  endif

  if nAlign != NIL
    ::oSheet:Cells( nRow, nCol ):Set("HorizontalAlignment",Alltrim(Str(nAlign)))
  endif

RETURN Self


/*
 *  TExcelScript():End()
 */
METHOD End( lClose ) CLASS TExcelScript
  DEFAULT lClose  := .T.
 
  If !::lExcel
     Return NIL
  End

  if lClose
    ::oExcel:WorkBooks:Close()
  endif

  if ValType(::oFind) == "O"
    ::oFind:End() ; ::oFind   := NIL
  endif

  if ValType(::oCell) == "O"
    ::oCell   := NIL  //::oCell:End() ;
  endif

  if ValType(::oSheet) == "O"
    ::oSheet  := NIL  //::oSheet:End();
  endif

  if ValType(::oBook) == "O"
    ::oBook   := NIL  //::oBook:End() ;
  endif

  ::oExcel  := NIL  //::oExcel:End()  ;

RETURN NIL


/*
 *  TExcelScript():Eval()
 */
METHOD eEval( cCommand, lOemAnsi, xParam ) CLASS TExcelScript   // [AD2K]

  DEFAULT lOemAnsi  := .F.
  If !::lExcel
     Return .f.
  End

  if lOemAnsi
     cCommand  := OemToAnsi( cCommand )
  endif

  // Soporte de lineas de Comentarios
  if Left( AllTrim( cCommand ), 1 ) $ "*/#"             // No procesar linea de comentario

  elseif Left( AllTrim( cCommand ), 1 ) == "!"          // Ejecutar Funcion Clipper/FW
    cCommand  := AllTrim(SubStr( cCommand, 2 ))
    Eval( &("{|oThis, uParam| " + cCommand + " }" ), Self, xParam )

  else                                                  // Ejecuta Metodo TExcelScript
    // Ahora sin uso de privadas [LKM]
    Eval( &("{|oThis, uParam| oThis:" + cCommand + " }" ), Self, xParam )

  endif

RETURN Self

/*
 *  TExcelScript():SubTotal()
 */
METHOD SubTotal( cRange, nGroup, nOpe, nCol  ) CLASS TExcelScript

  DEFAULT nOpe := 1

  If !::lExcel
     Return .f.
  End
 
  DO CASE
  CASE nOpe == 1
    nOpe := -4157   // Sum
  CASE nOpe == 2
    nOpe := -4106   // Ave
  CASE nOpe == 3
    nOpe := -4112   // Count
  CASE nOpe == 4
    nOpe := -4155   // StDev
   CASE nOpe == 5
    nOpe := -4156   // StDevP
  OTHERWISE
    nOpe := -4157   // Sum
  ENDCASE
 
  ::oSheet:Range( cRange ):SubTotal( nGroup, nOpe, nCol  )
 
RETURN Self

/*
 *  TExcelScript():Duplicate()
 */
METHOD Duplicate( cRange ) CLASS TExcelScript   // [AD2K]

  DEFAULT cRange  := ::oCell:Row

  ::oExcel:Rows( cRange ):Select()
  ::oExcel:Selection:Copy()
  ::oExcel:Selection:Insert()

RETURN Self

/*
 *  TExcelScript():Copy()
 */
METHOD Copy( cRange ) CLASS TExcelScript  

  If cRange == NIL
     RETURN Self
  End

  ::oExcel:Range( cRange ):Select()
  ::oExcel:Selection:Copy()

RETURN Self

/*
 *  TExcelScript():Paste()
 */
METHOD Paste() CLASS TExcelScript  

  ::oSheet:Paste()

RETURN Self

/*
 *  TExcelScript():Clear()
 */
METHOD eClear( cRange ) CLASS TExcelScript  // [AD2K]

  ::oExcel:Range( cRange ):Select()
  ::oExcel:Selection:Invoke("ClearContents")

RETURN Self

/*
 *  TExcelScript():Find()
 */
METHOD Find( cSearch, lMatch, lPart ) CLASS TExcelScript    // [AD2K]

  local oRange, lFound := .F.

  if cSearch == NIL
    RETURN lFound
  endif

  DEFAULT lMatch  := .F.  ,;
          lPart   := .F.

  ::GetCell():Activate()
  oRange := ::oSheet:Cells:Find( cSearch )

  if ValType( oRange ) == "O" .and. oRange[1] > 0
    oRange:Activate()

    ::GetCell()
    ::oFind   := oRange
    lFound    := .T.

    if (lMatch) .or. !(lPart)
      while !iif( lPart, cSearch $ ::Get( ::oCell:Row, ::oCell:Column ),  ;
                         cSearch == ::Get( ::oCell:Row, ::oCell:Column ))
        if !(::FindNext( oRange ))
          lFound  := .F.
          exit
        endif
      enddo
    endif
  endif

  RELEASE oRange

RETURN lFound

/*
 *  TExcelScript():FindNext()
 */
METHOD FindNext() CLASS TExcelScript    // [AD2K]

  local lFound := .F.
  local oRange, cRange, oCell

  if ValType( ::oFind ) == "O"
    oCell   := ::oCell
    cRange  := ::oExcel:Get( "ActiveCell" ):Address
    oRange  := ::oExcel:Cells:FindNext( ::oFind )

    if ValType( oRange ) == "O" .and. oRange[1] > 0
      oRange:Activate()
      ::GetCell()

      if ::oCell:Row == oCell:Row
        lFound  := ::oCell:Column > oCell:Column
      elseif ::oCell:Row > oCell:Row
        lFound  := .T.
      endif

      if lFound
        ::oFind := oRange
      else
        ::SetPos( cRange )
        ::oFind := NIL
      endif
    endif
  endif

RETURN lFound

/*
 *  TExcelScript():Replace()
 */
METHOD Replace( cSearch, cReplace, lMatch, lPart, lAll, lFull, cFormat ) CLASS TExcelScript    // [AD2K]

  local lFound  := .F.

  DEFAULT lAll  := .F.
  DEFAULT lFull := .F.

  if cReplace != NIL
    while ::Find( cSearch, lMatch, lPart )
      lFound := .T.

      if cFormat != NIL
        ::CellFormat( ,,,, cFormat )
      endif
     
      if (lFull)
        ::Say(,, cReplace )
      else
        ::Say(,, StrTran(::Get(), cSearch, cReplace ) )
      endif

      if !(lAll)
        exit
      endif
    enddo
  endif

RETURN lFound

/*
 *  TExcelScript():Chart()
 */
METHOD Chart( cRange , cTitle , nType , nDepth , nGapDepth, nLoc, cHoja )  CLASS TExcelScript    // [RimUs]
   LOCAL oChart , oSheet
   DEFAULT cTitle := "Grafica"
   DEFAULT nDepth := 20     // Profundidad de la Grafica
   DEFAULT nGapDepth := 20     // Separacion entre series
   DEFAULT nLoc := 2    // Como se desea insertar la Gr fica: 1=Hoja Individual 2=Como Objeto
   DEFAULT cHoja := ""  // Nombre de la hoja a insertar el gr fico

/*
oExcel:Charts:Add()
oRange := oExcel:Sheets("Sheet1"):Range(cRange)
oExcel:ActiveChart:SetSourceData(oRange, xlColumns)
oExcel:ActiveChart:Location(xlLocationAsObject, "Sheet1")

oExcel:ActiveChart:ChartType := xl3DPie
*/

   ::oSheet:Range( cRange ):Select()
   ::oExcel:Charts:Add()
   oChart := ::oExcel:Get( "ActiveChart" )
   oChart:ChartType := nType
   oChart:HasTitle := .T.
   oChart:ChartTitle:Text := cTitle
   oChart:Location( nLoc, cHoja )
//   oChart:DepthPercent := nDepth
//   oChart:GapthDepth := nGapDepth
RETURN Self

/*
 *  TExcelScript():AddCol()
 */
METHOD AddCol(  bAction , nAlign ,  bClrText , bClrPane , bHeading , bFooting ) CLASS TExcelScript    // [ Vikthor ]
   DEFAULT nAlign := 1  // Derecha
   DEFAULT bAction    := {|| ""}
   DEFAULT bClrText  := {||Rgb( 0,0,0)}
   DEFAULT bClrPane  := {||Rgb( 255,255,255)}
   DEFAULT bHeading  := {|| "" }
   DEFAULT bFooting  := {|| "" }
   
   aadd( ::aExcelCols , { bAction , nAlign , bClrText , bClrPane , bHeading , bFooting  } )
   
RETURN Self

/*
 *  TExcelScript():Browse()
 */
METHOD Browse( nRow , nCol , cAlias , cFont , nSize , bClrText , bClrPane ) CLASS TExcelScript    // [ Vikthor ]
   LOCAL nCiclo
   LOCAL nI
   
   ::nAt := 0
   DEFAULT cFont := "Tahoma"
   DEFAULT nSize := 10
   DEFAULT bClrText := {|| Rgb( 0 , 0 , 0)}
   DEFAULT bClrPane := {|| Rgb( 255 , 255 , 255 )}
   DEFAULT nRow := 1
   DEFAULT nCol := 1
   nCol--
   ::cAlias := cAlias
   
   IF !Empty( ::cAlias )
     /* encabezados */
     FOR nCiclo := 1 TO LEN( ::aExcelCols )
       ::Say( nRow , nCol + nCiclo, Eval( ::aExcelCols[nCiclo, 5 ] ), cFont, nSize,,,, ::aExcelCols[nCiclo, 2 ], ;
              Eval(  bClrText  ), Eval(  bClrPane  ) )
       ::Borders( , nRow , nCol+nCiclo , 1 )
     NEXT
     nRow ++
     /* arreglo o DBF */
     IF Lower(::cAlias) == "array"
        (::cAlias)->( DbGoTop() )
        FOR nI := 1 TO LEN( ::aData )
           FOR nCiclo := 1 TO LEN(::aExcelCols)
            ::Say( nRow , nCol+nCiclo, ::aData[nI,nCiclo], cFont, nSize,,,, ::aExcelCols[nCiclo, 2 ], ;
                  Eval(  ::aExcelCols[nCiclo, 3 ]  ), Eval(  ::aExcelCols[nCiclo, 4 ]  ) )
            ::Borders( , nRow , nCol+nCiclo , 1 )
           NEXT
           ::nAt++
           nRow++
        NEXT
     ELSE
        DO WHILE !(::cAlias)->(EOF())
           FOR nCiclo := 1 TO LEN(::aExcelCols)
              ::Say( nRow , nCol+nCiclo, Eval( ::aExcelCols[nCiclo, 1 ] ), cFont, nSize,,,, ::aExcelCols[nCiclo, 2 ], ;
                      Eval( ::aExcelCols[nCiclo, 3 ] ), Eval( ::aExcelCols[nCiclo, 4 ] ))
              ::Borders( , nRow , nCol+nCiclo , 1 )
           NEXT
           ::nAt++
           nRow++
           (::cAlias)->(DbSkip(1))
        ENDDO
     ENDIF
     /* Footers */
     FOR nCiclo := 1 TO LEN(::aExcelCols)
       ::Say( nRow , nCol+nCiclo, Eval( ::aExcelCols[nCiclo, 6 ] ), cFont, nSize,,,, ::aExcelCols[nCiclo, 2 ] ,;
              Eval(  bClrText  ), Eval(  bClrPane  ) )
       ::Borders( , nRow , nCol+nCiclo , 1 )
     NEXT
     FOR nCiclo := 1 TO LEN(::aExcelCols)
       ::AutoFit( nCol+nCiclo )
     NEXT
  ENDIF

RETURN Self

/*
 *  TExcelScript():Run()  // [CSR]
 */
METHOD Run(cRun)  CLASS TExcelScript

  ::oExcel:Run( cRun )

RETURN Self


/*
 *  TExcelScript():Bordersl() - LineStyle  // [CSR]
 */
METHOD Bordersl( cRange, nRow, nCol, nS1, nS2, nS3, nS4 )  CLASS TExcelScript

  DEFAULT nS1 := 1, nS2 := 1, nS3 := 1, nS4 := 1, cRange := ""
  If !::lExcel
     Return .f.
  End

  if Empty( cRange )
     IIf( !Empty( nS1 ), ::oSheet:Cells( nRow, nCol ):Borders(7):LineStyle  := nS1, )
     IIf( !Empty( nS2 ), ::oSheet:Cells( nRow, nCol ):Borders(8):LineStyle  := nS2, )
     IIf( !Empty( nS3 ), ::oSheet:Cells( nRow, nCol ):Borders(9):LineStyle  := nS3, )
     IIf( !Empty( nS4 ), ::oSheet:Cells( nRow, nCol ):Borders(10):LineStyle  := nS4, )
  else
     IIf( !Empty( nS1 ), ::oSheet:Range( cRange ):Borders(7):LineStyle  := nS1, )
     IIf( !Empty( nS2 ), ::oSheet:Range( cRange ):Borders(8):LineStyle  := nS2, )
     IIf( !Empty( nS3 ), ::oSheet:Range( cRange ):Borders(9):LineStyle  := nS3, )
     IIf( !Empty( nS4 ), ::oSheet:Range( cRange ):Borders(10):LineStyle  := nS4, )
  endif

RETURN Self

/*
 *  TExcelScript():Bordersw() - Weigth // [CSR]
 */
METHOD Bordersw( cRange, nRow, nCol, nS1, nS2, nS3, nS4 )  CLASS TExcelScript

  DEFAULT nS1 := 2, nS2 := 2, nS3 := 2, nS4 := 2, cRange := ""
  If !::lExcel
     Return .f.
  End

  if Empty( cRange )
     IIf( !Empty( nS1 ), ::oSheet:Cells( nRow, nCol ):Borders(7):Weight  := nS1, )
     IIf( !Empty( nS2 ), ::oSheet:Cells( nRow, nCol ):Borders(8):Weight  := nS2, )
     IIf( !Empty( nS3 ), ::oSheet:Cells( nRow, nCol ):Borders(9):Weight  := nS3, )
     IIf( !Empty( nS4 ), ::oSheet:Cells( nRow, nCol ):Borders(10):Weight  := nS4, )
  else
     IIf( !Empty( nS1 ), ::oSheet:Range( cRange ):Borders(7):Weight  := nS1, )
     IIf( !Empty( nS2 ), ::oSheet:Range( cRange ):Borders(8):Weight  := nS2, )
     IIf( !Empty( nS3 ), ::oSheet:Range( cRange ):Borders(9):Weight  := nS3, )
     IIf( !Empty( nS4 ), ::oSheet:Range( cRange ):Borders(10):Weight  := nS4, )
  endif

RETURN Self

/*
 *  TExcelScript():Bordersw() - Weigth // [CSR]
 */
METHOD BordersSubTot( cRange, nRow, nCol )  CLASS TExcelScript

  DEFAULT cRange := ""
  If !::lExcel
     Return .f.
  End

  if Empty( cRange )
     ::oSheet:Cells( nRow, nCol ):Borders(5):LineStyle := -4142
     ::oSheet:Cells( nRow, nCol ):Borders(6):LineStyle := -4142
     ::oSheet:Cells( nRow, nCol ):Borders(7):LineStyle := -4142
     ::oSheet:Cells( nRow, nCol ):Borders(10):LineStyle := -4142

     ::oSheet:Cells( nRow, nCol ):Borders(8):LineStyle := 1
     ::oSheet:Cells( nRow, nCol ):Borders(9):LineStyle := -4119
  else
     ::oSheet:Range( cRange ):Borders(5):LineStyle := -4142
     ::oSheet:Range( cRange ):Borders(6):LineStyle := -4142
     ::oSheet:Range( cRange ):Borders(7):LineStyle := -4142
     ::oSheet:Range( cRange ):Borders(10):LineStyle := -4142

     ::oSheet:Range( cRange ):Borders(8):LineStyle := 1
     ::oSheet:Range( cRange ):Borders(9):LineStyle := -4119
  endif

RETURN Self


/*
 *  TExcelScript():CloseBook()  // [CSR]
 */
METHOD CloseBook() CLASS TExcelScript

  ::oBook:End()
  ::oBook := NIL

RETURN NIL

/*
 *  TExcelScript():Add() // [CSR]
 */
METHOD Add( cFilexls )  CLASS TExcelScript
  If !::lExcel
     Return .f.
  End

  ::cFile := cFilexls

  TRY
     ::oExcel:WorkBooks:Add( ::cFile )
  CATCH  
     TRY
       ::oExcel:WorkBooks:Open( ::cFile )
     CATCH
       MsgAlert( "No se puede leer la hoja:"+::cFile,"Verifique por favor..." )
       RETURN .f.
     END
  END
 
  ::oBook       := ::oExcel:Get( "ActiveWorkBook")
  ::oSheet      := ::oExcel:Get( "ActiveSheet" )
  ::cFont       := "Arial"
  ::nSize       := 10
  ::lBold       := .F.
  ::lItalic     := .F.
  ::lUnderLine  := .F.
  ::nAlign      := 1
  ::lDefault    := .F.

  ::SetPos("A1")
  ::GetCell()

RETURN .t.

/*
 *  TExcelScript():Guardar() // [CSR]
 */
METHOD Guardar()  CLASS TExcelScript

  FErase( "c:\MisDoc~1\Reanudar.xlw" )
  ::oExcel:Save()

RETURN Self


/*
 *  TExcelScript():FreezePanel() // [CSR]
 */
METHOD FreezePanel( cRange )  CLASS TExcelScript
  If !::lExcel
     Return .f.
  End

  ::oExcel:Range( cRange ):Select()
  ::oExcel:Application:ActiveWindow:FreezePanes := .T.

RETURN Self

/*
 *  TExcelScript():FreezePanel() // [CSR]
 */
METHOD RanFontBold( cRange, nRow, nCol ) CLASS TExcelScript
  If !::lExcel
     Return .f.
  End

  DEFAULT cRange := "", nRow := ::oCell:Row, nCol := ::oCell:Column
 
  If !Empty( cRange )
     TRY
        ::oSheet:Range( cRange ):Font:Bold := .T.
     CATCH
     END
  Else
     TRY
        ::oSheet:Cells( nRow, nCol ):Font:Bold := .T.
     CATCH
     END
  End

RETURN Self

/*
 *  TExcelScript():Zoom( nZoom ) // [CSR]
 */
METHOD Zoom(nZoom)  CLASS TExcelScript

  DEFAULT nZoom := 100
  If !::lExcel
     Return .f.
  End

  ::oExcel:Application:ActiveWindow:Zoom := nZoom

RETURN Self

/*
 *  TExcelScript():Combinar( cRange ) // [CSR]
 */
METHOD Combinar( cRange )  CLASS TExcelScript
TRY
::oSheet:Range( cRange ):Merge()
CATCH
END
RETURN Self


METHOD Formula( cPos , cFormula ) CLASS TExcelScript //[CSR]
 TRY
 ::SetPos( cPos )
 ::oSheet:Range( cPos ):FormulaLocal := cFormula
 CATCH
   //MsgStop( "La formula no es correcta "+cFormula , "Aviso al usuario")
   cFormula := ""
 END
RETURN( Nil )

METHOD TablaDinamica( cRango ) CLASS TExcelScript //[CSR]
  If !::lExcel
     Return .f.
  End

 ::oPivot := ::oSheet:PivotTableWizard( 1,cRango,"","MiTablaDinamica")

RETURN( Nil )

METHOD SetRowTD( cRow ) CLASS TExcelScript //[CSR]

 ::oPivot:PivotFields(cRow):orientation := 1

RETURN( Nil )

METHOD SetColumnTD( cCol ) CLASS TExcelScript //[CSR]

 ::oPivot:PivotFields(cCol):orientation := 2

RETURN( Nil )

METHOD SetPageTD( cPage ) CLASS TExcelScript //[CSR]

 ::oPivot:PivotFields(cPage):orientation := 3

RETURN( Nil )

METHOD SetDataTD( cData ) CLASS TExcelScript //[CSR]

 ::oPivot:PivotFields(cData):orientation := 4

RETURN( Nil )

METHOD SetFormatTD( nFormato ) CLASS TExcelScript //[CSR]

 ::oPivot:Format( nFormato )

RETURN( Nil )


//METHOD SetFormulaTD( cName, cFormula ) CLASS TExcelScript //[JAAM]
// ::oPivot:PivotFormulas:add( 'PRECIO=CANTIDAD ' )
//RETURN( Nil )

*--// Crea Tabla Dinámica con fuente externa Vía OLE-Automation (ADO no es necesario MS-Query)
METHOD TablaFteExt( cConnStr, cQuery ) CLASS TExcelScript   //[JAAM]
 local oWorkbook, oTargetSheet, oTargetRange, oPivotCache

 *--// Crea un Nuevo Libro
 oWorkbook   := ::oExcel:Workbooks:Add()

 *--// Definir un objeto range para volcar los resultados.
 oTargetSheet:= oWorkbook:Get( 'ActiveSheet' )
 oTargetRange:= oTargetSheet:range('A2')

 *--// Crear un objeto pivot cache.
 oPivotCache := oWorkbook:PivotCaches:Add( 2 )   //  external data

 *--// Establecer en el objeto pivot cache el OLE-DB provider
 *--// y la sentencia SQL que Excel usará para leer los datos.
 oPivotCache:Connection := 'OLEDB;'+ cConnStr
 oPivotCache:Commandtext:= cQuery

 *--// Pide al objeto pivotcache que cree la tabla dinámica con los datos.
 ::oPivot:=oPivotCache:CreatePivotTable( oTargetRange, 'PivotTable' )

RETURN( Nil )


METHOD MoveSheet(cSheet,cPos,nSheet)
  If !::lExcel
     Return .f.
  End

  ::SetSheet(cSheet)
  If Upper(cPos)=="AFTER"
     ::oExcel:Sheets(cSheet):Move( , ::oExcel:Sheets( nSheet ) )
  Else
     ::oExcel:Sheets(cSheet):Move( ::oExcel:Sheets( nSheet ) )
  END

RETURN NIL

METHOD FormatoNumerico( cRango, cFormato ) CLASS TExcelScript //[CSR]
  If !::lExcel
     Return .f.
  End

  ::oExcel:Range( cRango ):Select()
  ::oExcel:Selection:NumberFormat = cFormato

Return NIL

METHOD ColumnWidth( nCol, nWidth ) CLASS TExcelScript //[CSR]
  If !::lExcel
     Return .f.
  End

  If ValType( nCol ) == "N"
     nCol := cColumn2Letter( nCol )+":"+cColumn2Letter( nCol )
  End

TRY  
  ::oSheet:Columns( nCol ):ColumnWidth := nWidth
CATCH
END

RETURN NIL


/*
 *   cColumn2Letter()
 */
FUNCTION cColumn2Letter( n )

   local r := ""

   if n > 26
      r := Chr( 64 + Int( n / 26 ) )
      n := n % 26
   endif

   r += Chr( 64 + n )

RETURN r

 

Espero te sirva.

Saludos cordiales.

Carlos.

[Cgallegoa]

Tocayo muchísimas gracias, funcionó perfecto. Te debo una