FiveTech Software tech support forums

////////////
// ExcelPaste.Prg   - Copia hojas y pega sobre un libro.
//
//
//
// Clases para Copiar de una o varias hojas excel a otra hoja excel
// destino
////////////////////////////////////////////////////////////////////////

#Include "FiveWin.Ch"
#Include "\prg\genlib\debug.ch"
#Include "\prg\genlib\xtry.ch"



STATIC aExcelAbierto:= {}
//-------------------------------------------------------------------------//
FUNCTION SampleExcelPaste()

Sample2()

RETURN NIL

//-------------------------------------------------------------------------//
STATIC FUNCTION Sample2()
Local oPaste, oOri
Local cPath:= "C:\plantillas\datos"

oPaste:= TExcelPaste():New()
oPaste:lVisible    := .f.
oPaste:cFileDestino:= PathCompleto("Destino-bis.xlsx")



// Nota: El orden final de aparicion de las hojas sera el mismo
// que se establezca aqui.

// PRIMER WORKBOOK ORIGEN
oOri:= TExcelPasteOrigen():New()
oOri:cFileOrigen := cPath+ "\Detalle factura de pruebas.xls"

oOri:cHojaOrigen := "Hoja1"
oOri:cHojaDestino:= "1Hoja1"        // Hoja destino
oOri:Add()
oPaste:Add(oOri)


oOri:= TExcelPasteOrigen():New()
oOri:cFileOrigen := cPath+ "\Tarifa Referencias.xlsx"          // Solo hoja origen. La hoja destino tendra el mismo nombre
oOri:cHojaOrigen := "Hoja1"
oOri:cHojaDestino:= "2Hoja1"        // Hoja destino
oOri:Add()
oPaste:Add(oOri)

oOri:= TExcelPasteOrigen():New()
oOri:cFileOrigen := cPath+ "\Lista de los Productos.xlsx"          // Solo hoja origen. La hoja destino tendra el mismo nombre
oOri:cHojaOrigen := "Hoja1"
oOri:cHojaDestino:= "3Hoja1"        // Hoja destino
oOri:Add()
oPaste:Add(oOri)


oPaste:Activate()


RETURN NIL


//-------------------------------------------------------------------------//
STATIC FUNCTION Sample1()
Local oPaste, oOri

oPaste:= TExcelPaste():New()
oPaste:lVisible    := .f.
oPaste:cFileDestino:= PathCompleto("Destino.xlsx")



// Nota: El orden final de aparicion de las hojas sera el mismo
// que se establezca aqui.

// PRIMER WORKBOOK ORIGEN
oOri:= TExcelPasteOrigen():New()
oOri:cFileOrigen := "Origen1.xlsx"


oOri:cHojaOrigen := "HojaOrigen1"         // Hoja origen
oOri:cHojaDestino:= "HojaDestino1"        // Hoja destino
oOri:Add()


oOri:cHojaOrigen:= "HojaOrigen2"          // Solo hoja origen. La hoja destino tendra el mismo nombre
oOri:Add()



oPaste:Add(oOri)



// SEGUNDO WORKBOOK ORIGEN
// Todas las hojas
oOri:= TExcelPasteOrigen():New()
oOri:cFileOrigen := "Origen2.xlsx"

oPaste:Add(oOri)



oPaste:Activate()


RETURN NIL




//--------------------------------------------------------------------------//
CLASS TExcelPaste


   METHOD New()

   METHOD Activate()


   METHOD Add(oOri)


   DATA aOrigen HIDDEN


   DATA cFileDestino

   DATA lVisible

   DATA oExcel, oBook     HIDDEN   // Destino
   DATA lSaveAs           HIDDEN

   METHOD lCrealoAbrelo() HIDDEN
   METHOD Save()          HIDDEN
   METHOD End()           HIDDEN
   METHOD PasteCuore()    HIDDEN
   METHOD CopyUno         HIDDEN

   // lNuevo indica si es nuevo: si existe, lo sobreescribe. Lo contrario
   // de lNuevo sera a¤adir a las hojas existentes
   DATA lNuevo INIT .T.        

ENDCLASS


//-------------------------------------------------------------------------//
METHOD New()                 CLASS TExcelPaste

::aOrigen:= {}
RETURN Self

//-------------------------------------------------------------------------//
METHOD Activate()            CLASS TExcelPaste
Local nI, nCountBorrar:= 0, oHoja
Local lAnterior, nVueltas:= 0, nUltima
Local nCount, oPage
::cFileDestino:= FileCarValidos(::cFileDestino)
IF !::lCrealoAbrelo()
   RETURN NIL
ENDIF
*
IF ::lNuevo
   // Renombro hojas existentes, que borrare al final, para que no
   // choquen con otras que se copien.
   #Define INI_BORRAR     "NOVALID_"
   #Define NAME_BORRAR(n) INI_BORRAR+ StrZero(n, 3)


   nCountBorrar:= ::oBook:WorkSheets:Count


   FOR nI:= 1 TO nCountBorrar
      oHoja:= ::oBook:WorkSheets(nI)


      // Como todas no se pueden borrar, dejo la ultima, pero
      // renombrada
      oHoja:Set("Name", NAME_BORRAR(nI)) // Para que no interfiera con hojas que se copiaran

   NEXT
   oHoja:= NIL
ENDIF
*

*
::PasteCuore()
*
IF nCountBorrar > 0
   // Borra las hojas existentes... al menos las Hoja1, Hoja2, Hoja3
   // que siempre estan aunque recien creado.
   // Se borra al final porque no se pueden borrar todas, asi que las borro
   // al final.


   lAnterior:= ::oExcel:DisplayAlerts
   ::oExcel:DisplayAlerts:= .f.           // IMPORTANTISIMO !!


   // Borrado por nombre porque la segunda vez, entrando y saliendo
   // del programa.
   DO WHILE .T.
      oHoja:= RetHoja(::oExcel, ::oBook, NIL, INI_BORRAR)
      IF oHoja == NIL
         EXIT
      ENDIF
      oHoja:Delete()
      *
      *
      // Control de cuelgue
      nVueltas++
      IF nVueltas > 50
         MERROR_("No se puede borrar hoja !!", oHoja, oHoja:Name)
         EXIT
      ENDIF
      *
   ENDDO


   ::oExcel:DisplayAlerts:= lAnterior


   oHoja:= NIL
ENDIF
*
// Pone tipo de papel. Por defecto: estrecho.
nCount:= ::oBook:WorkSheets:Count
FOR nI:= 1 TO nCount
   oHoja:= ::oBook:WorkSheets(nI)
   oPage:= oHoja:PageSetup


   // Configuracion de margenes igual que ESTRECHO
   oPage:LeftMargin  := 0.64
   oPage:RightMargin := 0.64
   oPage:TopMargin   := 1.91
   oPage:BottomMargin:= 1.91
   oPage:HeaderMargin:= 0.76
   oPage:FooterMargin:= 0.76


NEXT
*
::Save()
*

*
::End()
*
oHoja:= NIL
oPage:= NIL
*
RETURN NIL

//-------------------------------------------------------------------------//
METHOD End()                 CLASS TExcelPaste

   ::oBook:Close()
   ::oBook:= NIL

   ::oExcel:Quit()
   ::oExcel:= NIL

RETURN NIL

//-------------------------------------------------------------------------//
METHOD PasteCuore()          CLASS TExcelPaste
Local nI
Local oOri
Local oExcelOrigen, oBookOrigen
Local cHojaOrigen, cHojaDestino
Local nHojas, nHoja, oHojaTmp
Local oTry
Local cFileOrigen


*

oExcelOrigen:= CreateObjectExcel()
IF oExcelOrigen == NIL
   RETURN NIL
ENDIF



FOR nI:= Len(::aOrigen) TO 1 STEP -1   // Al reves para que el orden quede correcto

   oOri:= ::aOrigen[nI]
   *

   IF !File(oOri:cFileOrigen)
      MERROR_("No existe file excel origen !!", oOri:cFileOrigen)
      RETURN NIL
   ENDIF
   *
   cFileOrigen:= PathCompleto(oOri:cFileOrigen)
   *
   xTRY INI TO oTry
      oBookOrigen:= oExcelOrigen:WorkBooks:Open(cFileOrigen)
   xTRY END
   IF oTry:lError
      oTry:MsgError(oExcelOrigen, nI, oOri, oOri:cFileOrigen, cFileOrigen)
   ENDIF
   *
   *
   IF !Empty(oOri:aOrigen)
      // Se copia UNA o VARIAS hojas de este libro excel origen

      #Define POS_HOJA_ORIGEN  1
      #Define POS_HOJA_DESTINO 2
      FOR nHoja:= Len(oOri:aOrigen) TO 1 STEP -1 // Al reves para que el orden quede correcto

         oBookOrigen:Activate()  // importantisimo


         cHojaOrigen := oOri:aOrigen[nHoja, POS_HOJA_ORIGEN]
         cHojaDestino:= oOri:aOrigen[nHoja, POS_HOJA_DESTINO]

         IF Empty(cHojaDestino)
            cHojaDestino:= cHojaOrigen
         ENDIF
         cHojaDestino:= FileCarValidos(cHojaDestino)

         ::CopyUno(cFileOrigen, oExcelOrigen, oBookOrigen, cHojaOrigen, cHojaDestino)

      NEXT
   ELSE
      // Se copia TODAS las hojas de este libro excel origen
      nHojas:= oBookOrigen:WorkSheets:Count
      FOR nHoja:= nHojas TO 1 STEP -1            // Al reves para que el orden quede correcto

         oBookOrigen:Activate()  // importantisimo
         oHojaTmp:= oBookOrigen:WorkSheets( nHoja)
         *
         cHojaOrigen := oHojaTmp:Name
         cHojaDestino:= cHojaOrigen
         ::CopyUno(cFileOrigen, oExcelOrigen, oBookOrigen, cHojaOrigen, cHojaDestino)

          oHojaTmp:= NIL
      NEXT
   ENDIF
   *
   *
   *
   oBookOrigen:Close()
   oBookOrigen:= NIL
   *

NEXT
*
*
oExcelOrigen:Quit()
oExcelOrigen:= NIL


RETURN NIL
*
//-------------------------------------------------------------------------//
METHOD CopyUno(cFileOrigen, oExcelOrigen, oBookOrigen, cHojaOrigen, cHojaDestino) CLASS TExcelPaste
Local oHojaOrigen, oHojaDestino, oSelect
Local oTry
Local oExcelDestino:= ::oExcel
Local oRango
Local nI
Local nCols, oCellOri, oCellDes
Local nRows, oRowOri, oRowDes
Local nPics, oPicOri, oPicDes
Local nShapes, oShapeOri, oShapeDes
Local nFilIni, nFilFin, cRango
Local nUltimo
Local oTry2
*
*
oHojaOrigen:= RetHoja(oExcelOrigen, oBookOrigen, cHojaOrigen)

IF oHojaOrigen == NIL
   MERROR_("Hoja no encontrada !!", cFileOrigen, oExcelOrigen, cHojaOrigen)
   RETURN NIL
ENDIF
*
*
oHojaDestino:= ::oBook:WorkSheets:Add()
oHojaDestino:Activate()

*
xTRY INI TO oTry
   oHojaDestino:Set("NAME", cHojaDestino)
   *

   oRango:= oHojaOrigen:Cells()
   oRango:Copy()


   ::oBook:ActiveSheet:Paste()



   nCols:= oHojaOrigen:UsedRange:Columns:Count()

   FOR nI:= 1 TO nCols
      oCellOri:= oHojaOrigen:Cells(nI)

      oCellDes:= oHojaDestino:Cells(nI)
      oCellDes:ColumnWidth:= oCellOri:ColumnWidth
   NEXT


   // Tambien el height de las rows... porque no
   // sale perfecto con lo anterior. Esta operacion puede ser lenta.
   nRows:= oHojaOrigen:UsedRange:Rows:Count()

   FOR nI:= 1 TO nRows
      oRowOri:= oHojaOrigen:Rows(nI)

      oRowDes:= oHojaDestino:Rows(nI)
      oRowDes:RowHeight:= oRowOri:RowHeight
   NEXT



   #Define msoPicture   13
   nShapes:= oHojaOrigen:Shapes:Count()
   FOR nI:= 1 TO nShapes

      oShapeOri:= oHojaOrigen:Shapes:Item(nI)


      oShapeOri:Copy()

      oHojaDestino:Paste()
      nUltimo:= oHojaOrigen:Shapes:Count()
      xTRY INI TO oTry2
         oShapeDes:= oHojaDestino:Shapes:Item(nUltimo)
      xTRY END
      IF oTry2:lError
         *
         oTry2:SaveError(nI, nShapes, nUltimo, oShapeDes)  // Solo graba error... puede ser un error sin importancia
         *
         LOOP
      ENDIF

      oShapeDes:IncrementTop := - (oShapeDes:Top - oShapeOri:Top )
      oShapeDes:IncrementLeft:= - (oShapeDes:Left- oShapeOri:Left)

   NEXT




   
xTRY END

oHojaDestino:Cells(1,1):Select()  // Para que apague el seleccionado

IF oTry:lError
   oTry:MsgError(oExcelOrigen, cHojaOrigen, cHojaDestino,;
                 oHojaOrigen, oHojaDestino, nUltimo)
ENDIF
*
oHojaorigen := NIL
oHojaDestino:= NIL
oSelect     := NIL
oRango      := NIL
oCellOri    := NIL
oCellDes    := NIL
oRowOri     := NIL
oRowDes     := NIL
oPicOri     := NIL
oPicDes     := NIL
oShapeOri   := NIL
oShapeDes   := NIL
*
RETURN NIL
*
//-------------------------------------------------------------------------//
METHOD Add(oOri)             CLASS TExcelPaste
Aadd(::aOrigen, oOri)
RETURN NIL
*
//-------------------------------------------------------------------------//
METHOD lCrealoAbrelo()       CLASS TExcelPaste
Local cSaveAsFileName:= ::cFileDestino
Local oExcel, oBook, lSaveAs
Local bSaveHandler, oError

DO WHILE File(cSaveAsFileName) .AND. !lFiAccess(cSaveAsFileName)


      #Define MSG_EXCEL ;
        "­ Libro de Excel no disponible porque probablemente est  abierto!"+ CRLF+;
        "Ciérrelo y reintente la operación"+ CRLF+;
        "¨ Reintentar ?"
      IF !mMsgYesNo( MSG_EXCEL, FileNoPath(cSaveAsFileName))
        RETURN .f.
      ENDIF

ENDDO

oExcel:= CreateObjectExcel()
IF oExcel == NIL
   RETURN .F.
ENDIF



IF !File(cSaveAsFileName)
   lSaveAs:= .t.
   *
   *
   *
   *
   *
   *
   bSaveHandler := errorblock( { |x| break(x) } )

   BEGIN SEQUENCE
      oBook:= oExcel:WorkBooks:Add()

   RECOVER USING oError
      MERROR_( "­ Se produjo un error !",;
               ;
               cSaveAsFileName,;
               ;
               ;
               File(cSaveAsFileName),;
               IsDirectory(PathFile(cSaveAsFileName)),;
               ;
               ;
               ;
               ;
               oBook,;
               ;
               oError,;
               oError:SubSystem(),;
               oError:Description,;
               oError:Operation,;
               oError:SubCode,;
               oError:FileName,;
               DosError(),;
               FError(),;
               ;
               Ole2TxtError(),;
               ;
               ;
               GetEnv("TMP"),;
               GetEnv("TEMP"),;
               ;
               oExcel,;
               ;
               lFiAccess(cSaveAsFileName),;
               DosError(),;
               FError();       // File Error de lFiAccess()
               ;
              )

   END
   // Restore the default error handler
   errorblock( bSaveHandler )
   *
   *
   *
   *
   *
   *
   *
   *
ELSE
   lSaveAs:= .f.
   oBook:= oExcel:WorkBooks:Open(cSaveAsFileName)
ENDIF
*
oExcel:Visible:= ::lVisible
*
::oExcel:= oExcel
::oBook := oBook
::lSaveAs:= lSaveAs
RETURN .T.

//-------------------------------------------------------------------------//
METHOD Save()                CLASS TExcelPaste
Local cSaveAsFileName:= ::cFileDestino
Local oBook:= ::oBook
Local bSaveHandler, oError
Local lSaveAs:= ::lSaveAs
Local oExcel:=  ::oExcel

IF !lSaveAs
   // Lo borro antes de grabarlo para que no pregunte
   // si lo deseo sobreescribir
     *
     *
     *
     *
     *
     *
     *
     bSaveHandler := errorblock( { |x| break(x) } )

     BEGIN SEQUENCE
        oBook:Save()

     RECOVER USING oError
        MERROR_( "­ Se produjo un error !",;
                 ;
                 cSaveAsFileName,;
                 ;
                 ;
                 File(cSaveAsFileName),;
                 IsDirectory(PathFile(cSaveAsFileName)),;
                 ;
                 ;
                 ;
                 ;
                 ;
                 oBook,;
                 ;
                 oError,;
                 oError:SubSystem(),;
                 oError:Description,;
                 oError:Operation,;
                 oError:SubCode,;
                 oError:FileName,;
                 DosError(),;
                 FError(),;
                 ;
                 Ole2TxtError(),;
                 ;
                 ;
                 GetEnv("TMP"),;
                 GetEnv("TEMP"),;
                 ;
                 oExcel,;
            ;
            lFiAccess(cSaveAsFileName),;
            DosError(),;
            FError();       // File Error de lFiAccess()
            ;
                 )

     END
     // Restore the default error handler
     errorblock( bSaveHandler )
     *

ELSE
   TRY
      oBook:SaveAs(cSaveAsFileName) // Esto muy lento sobre todo cuando se generan varias hojas de calculo !!!!
   CATCH oError

       MERROR_( "­ Se produjo un error !",;
                ;
                cSaveAsFileName,;
                ;
                ;
                File(cSaveAsFileName),;
                IsDirectory(PathFile(cSaveAsFileName)),;
                ;
                ;
                ;
                ;
                oBook,;
                ;
                oError,;
                oError:SubSystem(),;
                oError:Description,;
                oError:Operation,;
                oError:SubCode,;
                oError:FileName,;
                DosError(),;
                FError(),;
                ;
                Ole2TxtError(),;
                ;
                ;
                GetEnv("TMP"),;
                GetEnv("TEMP"),;
                ;
                oExcel,;
            ;
            lFiAccess(cSaveAsFileName),;
            DosError(),;
            FError();       // File Error de lFiAccess()
            ;
               )


   END

ENDIF


RETURN NIL
*
//-------------------------------------------------------------------------//
// Agrupa Hojas de un mismo libro (cFileOrigen)
CLASS TExcelPasteOrigen

   METHOD New()
   METHOD Activate()
   METHOD Add()

   DATA cFileOrigen

   // MUCHO OJO !!! SOLO para parametros para :Add()
   DATA cHojaOrigen
   DATA cHojaDestino



   DATA aOrigen HIDDEN

ENDCLASS

//--------------------------------------------------------------------------//
METHOD New()                 CLASS TExcelPasteOrigen

::aOrigen:= {}
RETURN Self

//--------------------------------------------------------------------------//
METHOD Activate()            CLASS TExcelPasteOrigen

RETURN NIL

//--------------------------------------------------------------------------//
METHOD Add()                 CLASS TExcelPasteOrigen
Local aOri

// Control de errores mios para que solo se añada TODAS o una hoja
// en concreto UNA SOLA VEZ
IF AScanea(::aOrigen, {|x| x[1] == ::cHojaOrigen} ) > 0
   MERROR_("Este libro u hoja (NIL/hoja) ya ha sido añadido !!",;
           ::cHojaOrigen, ::aOrigen, aDebug(::aOrigen) )
   RETURN NIL
ENDIF

aOri:= {::cHojaOrigen, ::cHojaDestino}
Aadd(::aOrigen, aOri)

::cHojaOrigen := NIL
::cHojaDestino:= NIL

RETURN NIL

//-------------------------------------------------------------------------//
¤STATIC FUNCTION CreateObjectExcel()
Local oExcel
*
oExcel := TOleAuto():New( "Excel.Application" )

If Ole2TxtError() != "S_OK"
   MsgStop( "Error al intentar acceder a Excel","Error de conexión")
   oExcel:Quit()
   oExcel:= NIL
Endif
*
Aadd(aExcelAbierto, oExcel)
RETURN oExcel
*
//--------------------------------------------------------------------------//
STATIC FUNCTION RetHoja(oExcel, oBookOrigen, cNombreHoja, cIniNombreHoja)
Local nHojas, nI, oHojatmp, oHojaRet:= NIL
nHojas:= oBookOrigen:WorkSheets:Count // cuantas hojas tiene el libro de excel

FOR nI:= 1 TO nHojas //- 1

   oHojaTmp:= oBookOrigen:WorkSheets( nI )
   IF If(cNombreHoja != NIL, oHojaTmp:Name == cNombreHoja,;
                             cLeft(oHojaTmp:Name, cIniNombreHoja) )
      oHojaRet:= oHojaTmp
      EXIT
   ENDIF
NEXT
RETURN oHojaRet
*

*
*
//-------------------------------------------------------------------------//
EXIT PROCEDURE LimpiaMemoriaExcelPas()
Local nI
FOR nI:= 1 TO Len(aExcelAbierto)
   IF aExcelAbierto[nI] != nil
      aExcelAbierto[nI]:Quit()
   ENDIF
NEXT
RETURN NIL
*