359 lines
8.7 KiB
Plaintext
359 lines
8.7 KiB
Plaintext
***-----------------------------------------------------------
|
|
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
|
|
***-------------------------------------------------------------------------------------------
|