Class TOO
Onde posso encontrar a mais recente ?
Ari
*
* ----------------------------------------------------------------
*
FUNCTION OLEEXCEL97()
LOCAL oExcel, oHoja
oExcel := TOleAuto():New( "Excel.Application" )
oExcel:WorkBooks:Add()
oHoja := oExcel:ActiveSheet()
oHoja:Cells:Font:Name := "Arial"
oHoja:Cells:Font:Size := 12
oHoja:Cells( 3, 1 ):Value := "Texto:"
oHoja:Cells( 3, 2 ):Value := "Esto es un texto"
oHoja:Cells( 4, 1 ):Value := "Número:"
oHoja:Cells( 4, 2 ):NumberFormat := "#.##0,00"
oHoja:Cells( 4, 2 ):Value := 1234.50
oHoja:Cells( 5, 1 ):Value := "Lógico:"
oHoja:Cells( 5, 2 ):Value := .T.
oHoja:Cells( 6, 1 ):Value := "Fecha:"
oHoja:Cells( 6, 2 ):Value := DATE()
oHoja:Columns( 1 ):Font:Bold := .T.
oHoja:Columns( 2 ):HorizontalAlignment := -4152 // xlRight
oHoja:Columns( 1 ):AutoFit()
oHoja:Columns( 2 ):AutoFit()
oHoja:Cells( 1, 1 ):Value := "OLE desde FW"
oHoja:Cells( 1, 1 ):Font:Size := 16
oHoja:Range( "A1:B1" ):HorizontalAlignment := 7
oHoja:Cells( 1, 1 ):Select()
oExcel:Visible := .T.
oHoja:End()
oExcel:End()
RETURN
*
* ----------------------------------------------------------------
*
FUNCTION OLEExcel()
LOCAL oWnd, oMenu
MENU oMenu
MENUITEM "&Probar Excel y DBF"
MENU
MENUITEM "&Leer SIGLAS.XLS" ACTION LEER()
MENUITEM "&Enviar SIGLAS.DBF a Excel" ACTION ENVIAR() WHEN FILE( "SIGLAS.DBF" )
SEPARATOR
MENUITEM "&Salir" ACTION oWnd:End()
ENDMENU
ENDMENU
DEFINE WINDOW oWnd FROM 0,0 TO 20,70 MENU oMenu TITLE "Probar Excel y DBF"
ACTIVATE WINDOW oWnd MAXIMIZED
RETURN
FUNCTION LEER()
LOCAL oExcel, oHoja, nRows, nCols
LOCAL aCampos:={}, nRow, nCol
oExcel := TOleAuto():New( "Excel.Application" )
oExcel:WorkBooks:Open(SFN2LFN(cFilePath(GetModuleFileName(GetInstance()))+"SIGLAS.xls"))
oHoja := oExcel:Get( "ActiveSheet" )
nRows := oHoja:UsedRange:Rows:Count()
nCols := oHoja:UsedRange:Columns:Count()
FOR nCol := 1 TO nCols
IF ValType( oHoja:Cells( 2, nCol ):Value ) = "C"
AADD( aCampos, { oHoja:Cells( 1, nCol ):Value, "C", 80, 0 } )
ELSEIF ValType( oHoja:Cells( 2, nCol ):Value ) = "N"
AADD( aCampos, { oHoja:Cells( 1, nCol ):Value, "N", 15, 4 } )
ELSEIF ValType( oHoja:Cells( 2, nCol ):Value ) = "L"
AADD( aCampos, { oHoja:Cells( 1, nCol ):Value, "L", 1, 0 } )
ELSEIF ValType( oHoja:Cells( 2, nCol ):Value ) = "D"
AADD( aCampos, { oHoja:Cells( 1, nCol ):Value, "D", 8, 0 } )
ENDIF
NEXT
DBCREATE( "EXCEL", aCampos )
USE "EXCEL" NEW
FOR nRow := 2 TO nRows
APPEND BLANK
FOR nCol := 1 TO nCols
FIELDPUT( nCol, oHoja:Cells( nRow, nCol ):Value )
NEXT
NEXT
CLOSE DATABASES
oExcel:Quit()
oHoja:End()
oExcel:End()
MsgInfo( "Foi criado o arquivo EXCEL.DBF" )
RETURN
FUNCTION ENVIAR()
LOCAL oExcel, oHoja
LOCAL nRow := 1, nCol
oExcel := TOleAuto():New( "Excel.Application" )
oExcel:WorkBooks:Add()
oHoja := oExcel:Get( "ActiveSheet" )
USE "SIGLAS" NEW
FOR nCol := 1 TO FCOUNT()
oHoja:Cells( nRow, nCol ):Value := FieldName( nCol )
NEXT
DO WHILE .NOT. EOF()
nRow++
FOR nCol := 1 TO FCOUNT()
oHoja:Cells( nRow, nCol ):Value := FieldGet( nCol )
NEXT
SKIP
ENDDO
FOR nCol := 1 TO FCOUNT()
oHoja:Columns( nCol ):AutoFit()
NEXT
CLOSE DATABASES
oExcel:Visible := .T.
oHoja:End()
oExcel:End()
RETURN
Return to FiveWin for Harbour/xHarbour
Users browsing this forum: Google [Bot] and 67 guests