***-----------------------------------------------------------
Procedure get_excel_mask
	Lparameters tcInputMask
	Local lnint, lndec, lcInputMask
	lcInputMask=Strtran(tcInputMask,' ','')
	lnint = Iif(At('.',lcInputMask,1)>0,At('.',lcInputMask,1)-1,Len(lcInputMask))
	lndec = Iif(Rat('.',lcInputMask,1)>0,Len(lcInputMask)-Rat('.',lcInputMask,1),0)
	lnrest = Mod(lnint,3)

	lcString = Replicate("#",lnrest)
	lnint_ramas = lnint - lnrest
	Do While lnint_ramas > 0
		lcString = lcString + " " + Replicate("#",3)
		lnint_ramas = lnint_ramas - 3
	Enddo
	lcString=Substr(lcString,1,Len(lcString)-1)+"0"
	If lndec > 0
		lcString = lcString +"."+Replicate("0",lndec)
	Endif

	Return lcString

Endproc	&& get_excel_mask
***-----------------------------------------------------------
Procedure export_excel
	Lparameters toGrid,tcTitlu,tcCursor
	Local loXLSheet,loXLApp,poExcel
	Local i,k,lnCol,lnRow,lnColumn,lnObjCol
	Local lcCursor,lcNume,lcSirNume,lcSirColoane,lcInputMask
	Local llexista_Excel,llexista_invizibile

	Store '' To lcSirNume,lcSirColoane,lcInputMask
	Store .T. To llexista_Excel

	If Empty(tcCursor)
		lcCursor=toGrid.RecordSource
	Else
		lcCursor=tcCursor
	Endif

	k=0
	With toGrid
		For i=1 To .ColumnCount
			lnCol=1
			Do While i!=.Columns(lnCol).ColumnOrder
				lnCol=lnCol+1
			Enddo
			lnColumn=.Columns(lnCol).ColumnOrder
			If .Columns(lnCol).Visible
				lcSirColoane=lcSirColoane+.Columns(lnCol).ControlSource+','
				For lnObjCol=1 To .Columns(lnCol).Objects.Count
					If Upper(.Columns(lnCol).Objects(lnObjCol).BaseClass)='HEADER'
						lcNume=.Columns(lnCol).Objects(lnObjCol).Caption
						lcSirNume=lcSirNume+Strtran(Strtran(lcNume,Chr(32),'_'),'.','_')+','
						Exit
					Endif
				Endfor
			Else
				k=k+1
			Endif
		Endfor
		lcSirColoane=Substr(lcSirColoane,1,Len(lcSirColoane)-1)
		lcSirNume=Substr(lcSirNume,1,Len(lcSirNume)-1)
	Endwith

	Try
		*!*	On Error Do exportare With lcCursor,lcSirColoane,lcSirNume
		loXLSheet = Getobject('','excel.sheet')
		*!*	On Error
		llexista_invizibile=.F.
		*!*	If llexista_Excel
		Wait Window "Se transmit datele catre Excel..." Nowait

		If k>0
			Dimension laInvizibile(k)
			llexista_invizibile=.T.
		Endif

		loXLApp = loXLSheet.Application

		loXLApp.workbooks.Close()
		loXLApp.workbooks.Add()
		poExcel = loXLApp.ActiveSheet

		Select &lcCursor
		Go Top
		poExcel.Cells(1,1).Font.Size=16
		poExcel.Cells(1,1).Font.Bold=.T.
		poExcel.Cells(1,1)=tcTitlu+" Luna "+Alltrim(Str(gnLuna))+"/"+Alltrim(Str(gnAn))
		lnRow = 3
		k=1
		With toGrid
			For lnCol = 1 To .ColumnCount
				lnColumn = .Columns(lnCol).ColumnOrder
				If .Columns(lnCol).Visible
					poExcel.Columns(lnColumn).ColumnWidth = .Columns(lnCol).Width/5
					lcInputMask=.Columns(lnCol).InputMask
					If At('9',lcInputMask)>0
						poExcel.Columns(Chr(64+lnColumn)).EntireColumn.NumberFormat=get_excel_mask(lcInputMask)
					Endif
					For lnObjCol=1 To .Columns(lnCol).Objects.Count
						If Upper(.Columns(lnCol).Objects(lnObjCol).BaseClass)='HEADER'
							poExcel.Cells(lnRow,lnColumn) = .Columns(lnCol).Objects(lnObjCol).Caption
							Exit
						Endif
					Endfor
					poExcel.Cells(lnRow,lnColumn).Font.Bold = .T.
					poExcel.Cells(lnRow,lnColumn).Interior.ColorIndex = 16
				Else
					laInvizibile(k)=lnColumn
					k=k+1
				Endif
			Endfor

			Select &lcCursor
			Scan
				lnRow = lnRow + 1
				For lnCol = 1 To .ColumnCount
					If .Columns(lnCol).Visible
						lnColumn = .Columns(lnCol).ColumnOrder
						If At('CHECK',Upper(.Columns(lnCol).CurrentControl))>0
							poExcel.Cells(lnRow,lnColumn)=Iif(Eval(.Columns(lnCol).ControlSource)==0,'NU','DA')
						Else
							poExcel.Cells(lnRow,lnColumn) = Iif(Isnull(Eval(.Columns(lnCol).ControlSource)),'',Eval(.Columns(lnCol).ControlSource))
						Endif
					Endif
				Endfor
			Endscan

			If llexista_invizibile
				Asort(laInvizibile)
				For i = 1 To Alen(laInvizibile)
					poExcel.Columns(Chr(65+laInvizibile(i)-i)).Delete
				Endfor
			Endif
		Endwith

		loXLApp.Visible = .T.
		*!*	Endif
	Catch
		Do exportare With lcCursor,lcSirColoane,lcSirNume
	Finally

	Endtry


Endproc && export_excel
***-----------------------------------------------------------
Procedure exportare
	Lparameters tabel, Initial, Final
	Local  nrc, i, c
	Store 0 To nrc, i
	Store '' To c

	A='C:\MY DOCUMENTS'
	B='C:\DOCUMENTS AND SETTINGS'
	Do Case
		Case Directory('&A')
			Set Default To '&A'
		Case Directory('&B')
			Set Default To '&B'
		Otherwise
			Md &A
			Set Default To '&A'
	Endcase

	exista_excel=.F.

	Initial = ','+Initial+',' 	&&Pentru a recunoaste coloanele'
Final = ','+Final+',' 		&&---||---

	nrc = Occurs(',', '&initial')
	nrc=nrc-1 				&& scade virgula din fata

	Local Array c_initial(nrc)
	Local Array c_final(nrc)

	For i = 1 To nrc
		N = At(',', '&initial', i)
		n2 =At(',', '&initial', i+1)
		c_initial[i] = Substr('&initial', N+1, n2-N-1)
		N = At(',', '&final', i)
		n2 =At(',', '&final', i+1)
		c_final[i] = Substr('&final', N+1, n2-N-1)
	Endfor

	For i=1 To nrc
		If i=nrc
			c=c+c_initial[i]+' as '+c_final[i]
		Else
			c=c+c_initial[i]+' as '+c_final[i]+','
		Endif
	Endfor

	calea_fis = Putfile('Nume fisier:', 'Foaie_Excel', 'XLS')
	If Empty(calea_fis)  	&& Esc pressed
		Return
	Endif

	If Used('crsexport')
		Use In crsexport
	Endif

	Select &tabel
	lcFiltru=Filter()

	Select &c From &tabel Where &lcFiltru Into Cursor crsexport
	Select crsexport
	Export To (calea_fis) Type Xl5

	Set Default To &DIRGEN

	Use In crsexport
Endproc



*!* 12.05.2006
*!* MARIUS MUTU
********************************************************************************************************
Procedure export_excel_grid
	Lparameters toGrid, tcOrder, tcWhere, tcTitlu

	If Type('toGrid') # 'O'
		Return
	Endif

	Local lcColumnList, lcHeaderList, lcSelect, llSelect, lcFrom, lcWhere, lcOrder, lcOutput

	lcFrom = toGrid.RecordSource
	lcWhere = Iif(!Empty(tcWhere) And Type('tcWhere') = 'C', tcWhere, Filter(lcFrom))

	lcColumnList = ''
	lcHeaderList = ''
	lcSelect = ''
	llSelect = .T.
	lcType = 'CURSOR'
	lcOrder = Iif(Empty(tcOrder) Or Type('tcOrder') # 'C', "", tcOrder)
	lcOutput = Sys(2015)

	get_schema_grid(toGrid,@lcColumnList, @lcHeaderList, @lcSelect, llSelect, lcType, lcFrom, lcWhere, lcOrder, lcOutput)
	&lcSelect

	If Used(lcOutput)
		Do export_xls With lcOutput, tcTitlu In oproceduri_comune.prg
		Use In (lcOutput)
	Endif


Endproc && export_excel_grid

***-------------------------------------------------------------------------------------------
Procedure LIST_EXCEL
	Param TTABEL,TTITLU,TAHEADER

	External Array TAHEADER
	A='C:\MY DOCUMENTS'
	B='C:\DOCUMENTS AND SETTINGS'
	Do Case
		Case Directory('&A')
			Set Default To '&A'
		Case Directory('&B')
			Set Default To '&B'
		Otherwise
			Md &A
			Set Default To '&A'
	Endcase
	lcNumeDirExcel = Putfile('Nume fisier:', 'Foaie_Excel', 'XLS')
	If Empty(lcNumeDirExcel)  	&& Esc pressed
		Return
	Endif


	*!*		lcNumeDirExcel = ADDBS(calefirma)+"Excel\"
	*!*		IF !DIRECTORY(lcNumeDirExcel)
	*!*			MD (lcNumeDirExcel)
	*!*		ENDIF

	*!*		lcdata = STRTRAN(DTOC(DATETIME()),"/","_")
	lcfis = lcNumeDirExcel +"LIST_"+Sys(2)+".XLS"


	lcfis=Strtran(lcfis,'\\','\')

	Set Textmerge On To (lcfis) Noshow
	LCANTET=Uppe(Allt(TTITLU))+crlf
\
\\<<LCANTET>>
\
	If Parameters()<3
		LCHEADER=""
		Sele (TTABEL)
		For i=1 To Fcount()
			LCHEADER=LCHEADER+Upper(Allt(Field(i)))+Tab
		Endfor
		LCHEADER=LCHEADER+crlf
\\<<LCHEADER>>

		Sele (TTABEL)
		Scan
			LDATE=""
			For i=1 To Fcount()
				F=Field(i)
				T=&F
				LDATE=LDATE+Transform(T,Iif(Type(F)="N","999999999999999.99",''))+Tab
			Endfor
			LDATE=LDATE+crlf
	\\<<LDATE>>
		Endscan
		Set Textmerge To
	Else
		LCHEADER=""
		NRCOL=Alen(TAHEADER,1)
		Sele (TTABEL)
		For i=1 To NRCOL

			If Empty(TAHEADER[I,1])
				LCHEADER=LCHEADER+Upper(Allt(TAHEADER[I,2]))+Tab
			Else
				LCHEADER=LCHEADER+Upper(Allt(TAHEADER[I,1]))+Tab
			Endif

		Endfor
		LCHEADER=LCHEADER+crlf

\\<<LCHEADER>>

		Sele (TTABEL)
		Scan
			LDATE=""
			For i=1 To NRCOL
				*				F=Field(TAHEADER[I,2])
				F=TAHEADER[I,2]
				*				IF EXISTACAMP(,F)
				T=&F
				LDATE=LDATE+Alltrim(Transform(T,Iif(Type(F)="N","999999999999999.99",'')))+Tab
				*				ELSE
				*					LDATE=LDATE+" "+Tab
				*				ENDIF
			Endfor
			LDATE=LDATE+crlf
	\\<<LDATE>>
		Endscan
		Set Textmerge To
	Endif
	*		WAIT WINDOW "Se deschide Excel..." NOWAIT



	OEXCEL = Createobject("Excel.Application")
	OEXCEL.workbooks.Open(lcfis)
	OEXCEL.Visible=1
	*!*			IF TYPE(OEXCEL)='0'
	*!*				OEXCEL=""
	*!*			ENDIF

Endproc && list_excel
***-------------------------------------------------------------------------------------------