Import initial din SVN ROAAUTO/Trunk @HEAD
This commit is contained in:
358
COMUN/programe/proceduri_excel.prg
Normal file
358
COMUN/programe/proceduri_excel.prg
Normal file
@@ -0,0 +1,358 @@
|
||||
***-----------------------------------------------------------
|
||||
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
|
||||
***-------------------------------------------------------------------------------------------
|
||||
Reference in New Issue
Block a user