Os presento una clase que refunde libros excel en un solo libro excel.
Características:
- Infinitos libros a refundir
- Posibilidad de renombrar nombres hojas origen
Espero que os sirva.
- Code: Select all Expand view
////////////
// 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
*
Saludos
