EXCEL

HMG en Español

Moderator: Rathinagiri

Post Reply
User avatar
SALINETAS24
Posts: 297
Joined: Tue Feb 27, 2018 3:06 am
DBs Used: DBF
Has thanked: 10 times
Been thanked: 16 times

EXCEL

Post by SALINETAS24 » Thu Jan 31, 2019 9:37 pm

Hola amigos.
Os paso una pequeña rutina que permite pasar a EXCEL cualquier fichero seleccionando los campos y permitiendo condicionar los registros a mostrar. Una especie de DO REPORT pero para las EXCEL.
Por un lado tenemos el INCLUDE

Code: Select all

#xcommand   DO LIBRO_EXCEL  ;
					TITULO   	<ctitle>		;           // -->Titulo del Infomer
					CABECERA	<aCabecera>     ;		//--> Array con el nombre de las columnas
					FIELDS  	<aCampos>  		;	//--> nº de orden del Campo de la DBF a mostar 
					FORMATO 	<aFormatos>     ;		//--> formato ("9990", nil,etc)
					WORKAREA 	<calias>    	;              // --> el alias a trabajar
					[ WHILE 	<xWhile> ] 		;      // --> la condicion, por defecto WHILE !eof()
	=>;
LIBROEXCEL( <ctitle> 		,	 	;
				<aCabecera> , 		;
				<aCampos> 	,		;
				<aFormatos>	,		;
           			<(calias)>  ,  		;
				<{xWhile}>		)
Ahora vamos con la función, por un lado LIBROEXCEL es la función principal y la que se encarga de todo el trabajo. Por otro lado SAVEFIELDS, esta última es una función que utilizo para pasar los campos de la DBF a un array.

Code: Select all

/ ------------------------------------------------------------------------------
// ------------------------------------------------------------------------------
// --> LibroExcel()
// Función que pasa los registros selecionados a una hoja de calculo
// --> Recibe
// --> cTitulo     -> Titulo del listado
// --> aCampos     -> Array con los campos a imprimir
// --> aFormatos   -> Array con los Los formatos de los campos
// --> cAlias	   -> Alias del fichero
// --> xWhile      -> La Condicion 


PROC LibroExcel(cTitulo,aTitulo,aCampos,aFormatos,cAlias,xWhile)
LOCAL i, nVez,nRow:=0
LOCAL aFields:={}
* define xlPaperLegal 5
* define xlPaperLetter 1 
	nVez:=0
	SELECT(cAlias)
	Wait Window "Trabajando para usted, Espere . . ." NOWait 
	
	// --> Empieza el lio
	DO WHILE IF(!empty(xWhile),EVAL(xWhile),!eof())
		DO EVENTS
		// --> la Cabecera
		IF nVez=0
			nVez=1
			oExcel = CREATEObject( "Excel.ApplicatiOn" ) && llama a  excel
			oExcel:WorkBooks:Add() && crea archivo
			oSheet = oExcel:ActiveSheet && crea hoja
			oExcel:ActiveSheet:PageSetup:PaperSize := 1 // xlPaperLetter //xlPaperLegal //Tamaño de la hoja
			oSheet:PageSetup:Orientation := 1 &&'xlLandscape' 1 && 'xlPortrait' 2
			nRow++
			nRow++
			nRow++
			With Object oSheet //titulos de columnas
				For i = 1 To Len(aTitulo)
						:Cells(nRow, i):Value = aTitulo[i]
						:Cells(nRow,i):ShrinkToFit = .T. //Disminuye el tamaño de la letra para ajustar
				Next
			End
		nRow++
		ENDIF
		(cAlias)->(SaveFields(aFields))
		FOR i:=1 To LEN(aCampos) 
			oSheet:Cells(nRow,I):Value := aFields[aCampos[i]]
			IF !EMPTY(aFormatos[i])
				oSheet:Cells(nRow,I):NumberFormat = aFormatos[i]
			ENDIF
		NEXT
		IF  nRow/2 == int(nRow/2) //Color de fondo de la celda
			For i=1 To LEN(aCampos)
				oSheet:Cells( nRow, i ):Interior:ColorIndex := 34 //maximo 56
			Next
		EndIf 
		nRow++
		/// --> Muevo el puntero,
		SKIP		
	ENDDO
	//--> tamaño de letra mas grande para el titulo
	oSheet:Cells(1,1):Font:Size := 14 
	oSheet:Cells( 1, 1 ):Value := cTitulo
	// --> Negrita para los titulos de las columnas
	FOR i=1 To Len(aCampos) 
		oSheet:Cells( 4, i ):Font:Bold := .T.
	NEXT
	// --> Redimension Columnas
	FOR i:=1 To LEN(aFields)
		oSheet:Columns(i):ColumnWidth := LEN(aFields[i])
	NEXT
	// --> Repite las primeras filas en cada hoja de impresion
	oSheet:PageSetup:PrintTitleRows = "$1:$4" 
	// --> Termina y lo hace visible
	Wait Clear
	oExcel:Visible = .T.
	
RETURN

// ----------------------------------------------------------------------------
// Categoria: FUNCIONES BASE DE DATOS
// ----------------------------------------------------------------------------
// Pasa los FIELDS de una base de datos a un Array
// Sintax
// SaveFields( <aData>, nIni ) --> nil
// Parametros
// <aData> es el array que queremos cargar.
// <nIni>  Valor númerico.  0 carga, 1 inicializa
//         Por defecto, el valor será cero

proc SaveFields( aData, nIni )

   local n
   local nLen := FCount()
   local aFtip[nLen]
   local aFlon[nLen]
   Default nIni := 0

   AFields("",aFtip,aFlon,"")
   ASize( aData, 0 )

   for n = 1 to nLen
      AAdd( aData, FieldGet( n ) )
      IF nIni=1
         DO Case
            Case aFtip[n]="N"
*                 STORE 0 TO aData[n]
				  aData[n]:=0
            Case aFtip[n]="C"
				  aData[n]:=""			  
*                 STORE SPACE(aFlon[n]) to aData[n]
*                 lMsgStop(str(aFlon[n]))
            Case aFtip[n]="D"
                 aData[n]:=DATE()
            Case aFtip[n]="L"
                 aData[n]:=.f.
            OTHERWISE
                 aData[n]:=""
*				 STORE SPACE(aFlon[n]) to aData[n]
         ENDCASE
      ENDIF
   next

return
Y una vez incluido ese código en nuestra librería.., para hacer una hoja excel solo necesitaremos esas lineas...

Code: Select all

// LLAMADA

	DO LIBRO_EXCEL ;
					TITULO   	"LISTADO DE PRUEBA"	;
					CABECERA	 {'CODIGO','DESCRIPCION'}      	;
					FIELDS  	{1,2} 						;
					FORMATO 	 {"####0",NIL}     				;
					WORKAREA 	 Articulos    				;
					WHILE 	!Articulos->(EOF()) 
					
RETURN
Y como muestra mejor un botón, os paso un arreglo que he hecho utilizando el ejemplo GRID_13.
De esta manera y una vez personalizado el formato de tus excel, podrás crear cualquier hoja e imprimir los campos que quieras utilizando muy poco codigo y evitando repeticiones aburridas.

Muchas gracias por vuestra atención y vamos con unas cervecitas bien fresquitas!!
Attachments
GRID_13.rar
sample/grid_13 ejemplo para EXCEL
(1.25 MiB) Downloaded 61 times

User avatar
bpd2000
Posts: 1057
Joined: Sat Sep 10, 2011 4:07 am
Location: India
Has thanked: 191 times
Been thanked: 87 times

Post by bpd2000 » Fri Feb 01, 2019 6:38 am

Excellent
Thank you for sharing
BPD
Convert Dream into Reality through HMG

User avatar
serge_girard
Posts: 2233
Joined: Sun Nov 25, 2012 2:44 pm
DBs Used: 1 MySQL - MariaDB
2 DBF
Location: Belgium
Has thanked: 516 times
Been thanked: 110 times
Contact:

Post by serge_girard » Fri Feb 01, 2019 8:20 am

Thanks for sharing!

Serge

User avatar
mustafa
Posts: 790
Joined: Fri Mar 20, 2009 11:38 am
DBs Used: DBF
Location: Alicante - Spain
Been thanked: 109 times
Contact:

Post by mustafa » Fri Feb 01, 2019 12:26 pm

Muy logrado , me gusta
estas fet un mestre , che!!!
Una abraçada
Mustafa

User avatar
SALINETAS24
Posts: 297
Joined: Tue Feb 27, 2018 3:06 am
DBs Used: DBF
Has thanked: 10 times
Been thanked: 16 times

Post by SALINETAS24 » Fri Feb 01, 2019 6:07 pm

Muchas gracias and Thank you !!

Un bug localizado.

Cambiar las lineas de redimensión de columnas por estas, da un error cuando el campo no es alfabético.

Code: Select all

	// --> Redimension Columnas
	FOR i:=1 To LEN(aFields)
		IF VALTYPE(aFields[i])="C"
			oSheet:Columns(i):ColumnWidth := LEN(aFields[i])
		ENDIF
	NEXT
Vamos con unas cervecitas!!

ASESORMIX
Posts: 91
Joined: Thu Oct 25, 2012 8:08 pm
Location: Bqto, Venezuela
Been thanked: 6 times

Post by ASESORMIX » Tue Feb 05, 2019 8:56 pm

Muchas Gracias por su colaboracion.

Post Reply