Hello, from Germany
This is a part of the new DB-Tool you will find in the forum
in a short time
It is possible to create a formated Excel-Sheet of any DBF-File.
With the parameter lOemAnsi = .T. you can convert the DBF to Ansi
The needed cellwidth is calculated.
The Excel-Sheet can work with 4 Windows
Its quick and easy to handle.
// -------------------------------------------
STATIC FUNCTION EXP_EXCEL(cFile1,lOemAnsi )
LOCAL oDlg7, oMeter, oBtn1
c_dir := GetModuleFilename(GetInstance(),"DBF_G.EXE" + CHR(0), 255)
//-----------------------------------------------Applic.-Name
c_path := left ( c_dir, rat( "\", c_dir) -1 )
cFILE := c_path + "\" + cFileNoExt(cFile1)
DEFINE DIALOG oDlg7 FROM 1, 1 TO 12, 44 ;
TITLE "Creating : " + cFile + ".XLS"
DBSELECTAREA(1) // Your Database !!!!!!
nTotal := RECCOUNT()
DBGOTOP()
nActual := 0
@ 1.5, 2 METER oMeter VAR nActual TOTAL 10 OF oDlg7 SIZE 135, 15 UPDATE
@ 2.5, 8 BUTTON "&Start" size 80, 25 OF oDlg7 ;
ACTION EXP_RUN(oDlg7, oMeter, cFile1,lOemAnsi)
ACTIVATE DIALOG oDlg7 CENTERED
RETURN( NIL )
//---------- EXCEL Sheet cFile = DBF-Name / lOemAnsi .T. or .F. ------//
STATIC FUNCTION EXP_RUN(oDlg7,oMeter,cFile1,lOemAnsi)
LOCAL oClp
LOCAL nSheets := 0
LOCAL n := 0
LOCAL nRow := 0
LOCAL nHeaderRow := 1
LOCAL nDataStart := nHeaderRow + 1
LOCAL FIELD_ARRAY := {}
DBSELECTAREA(1) // Your Database !!!!!!
aFieldname := (1)->( DbStruct() )
nLenght := Len( aFieldname )
for n = 1 to nLenght
AADD( FIELD_ARRAY, { aFieldname[ n ][ 1 ], ;
aFieldname[ n ][ 2 ], ;
aFieldname[ n ][ 3 ] } )
next
// CLIPBOARD
DEFINE CLIPBOARD oClp
oExcel := TOleAuto():New( "Excel.Application" )
oWorkBook := oExcel:WorkBooks:Add()
nSheets := oExcel:Sheets:Count()
for n := 1 to nSheets - 1
oExcel:Worksheets( n ):Delete()
next
oExcel:Set( "DisplayAlerts", .f. )
oSheet := oExcel:Get( "ActiveSheet" )
oWin := oExcel:Get( "ActiveWindow" )
oSheet:Name := "Show"
oSheet:Cells( nDataStart, 1 ):Select()
oWin:Set( "FreezePanes", .t. )
oWin:Set( "SplitColumn", 2 ) // Freeze Rows and Cols
oSheet:Cells:Font:Size := 10
oSheet:Cells:Font:Name := "Arial"
For i := 1 to nLenght
oSheet:Cells( 1, i ):Value := aFieldname[ i ][ 1 ]
oSheet:Cells( nHeaderRow, i ):Font:Bold := .t.
oSheet:Cells( nHeaderRow, i ):Font:Color := RGB( 255, 0, 0 )
IF aFieldname[i][3] > 10
oSheet:Columns( i ):Set( "ColumnWidth", aFieldname[i][3] )
ELSE
oSheet:Columns( i ):Set( "ColumnWidth", 13 ) // Minimum
ENDIF
Next
nRow := nHeaderRow + 1
CURSORWAIT()
Do While !Eof()
i := 1
cTEXT := ""
For i := 1 to nLenght
IF lOemAnsi = .T. .and. ( aFieldname[ i ][ 2 ] = "C" ;
.or. aFieldname[ i ][ 2 ] = "M" )
cTEXT := cTEXT + OemToAnsi( FIELDGET(i) )
ENDIF
IF lOemAnsi = .F. .and. ( aFieldname[ i ][ 2 ] = "C" ;
.or. aFieldname[ i ][ 2 ] = "M" )
cTEXT := cTEXT + FIELDGET(i)
ENDIF
IF aFieldname[ i ][ 2 ] = "N"
cTEXT := cTEXT + STR(FIELDGET(i))
ENDIF
IF aFieldname[ i ][ 2 ] = "D"
cTEXT := cTEXT + DTOS(FIELDGET(i))
ENDIF
IF aFieldname[ i ][ 2 ] = "L"
IF FIELDGET(i) = .T.
cTEXT := cTEXT + "TRUE"
ELSE
cTEXT := cTEXT + "FALSE"
ENDIF
ENDIF
cTEXT := cTEXT + chr( 9 )
Next
oClp:SetText( cText )
oSheet:Cells( nRow, 1 ):Select()
oSheet:Paste()
oClp:Clear()
DbSkip()
oMeter:Set( nActual +1 )
nRow++ // Linefeed
IF EOF()
EXIT
ENDIF
EndDo
oDlg7:End() // End Dlg MsgMeter
oSheet:Cells( 2, 1 ):Select() // Start-Cursor
oWorkBook:SaveAs("&cFile")
oClp:Clear()
oExcel:Visible := .T.
oExcel := NIL
RETURN( NIL )
Regards
U. König