| Subject | Re: Dbase IV |
| From | Bernard Mouille <bernard.mouille@free.fr> |
| Date | Tue, 02 Aug 2022 01:06:28 -0400 |
| Newsgroups | dbase.getting-started |
| Attachment(s) | Test.txt |
Hello Akshat, If you have 10 minutes, can you test the attached code after modify the number formats ? Regards, Bernard | |
*// Test.prg *// Convert dbf file to Excel file. *// This code is a basic sample. *// Using Visual dBase 5.7 or dBasePlus 2.01 or dBasePlus 9.51. *// The cells formats arent for the french country, change if not french. *// Look if the function ansi() is wanted. *// Look if the decimal deparator is coma or point. *// This code execute can be long time for big table. *// Output file Excel. #define Excel_File12 set( "directory" ) + "\_Result.xlsx" #define Excel_File11 set( "directory" ) + "\_Result.xls" *// https://www.automateexcel.com/excel-formatting/color-reference-for-color-index/#VBA_Color_Index_Codes_List #define COLOR_YELLOW 6 #define COLOR_GRAY15 15 clear all clear local aFields local cFormat local nCol local nRow local oBook local oCol local oCell local oExcel local oSheet private cPath private cTable private fName *// For load the batch file : << c:\VISUALDB\BIN\DBASEWIN.exe %~dp0Test.prg >> cPath = substr( program( 0 ), 1, rat( "\", program( 0 ) ) - 1 ) set directory to &cPath #ifdef __version__ if __version__ < 3 cTable = getfile( "*.dbf*", "Select Dbf file" ) else cTable = getfile( "", "Select Dbf file", .T., "Dbf files ( *.dbf* )" ) endif #else cTable = getfile( "*.dbf*", "Select Dbf file" ) #endif if len( cTable ) == 0 release cPath msgbox( "Dbf file not selected, abort.", "Error", 48 ) return endif use &cTable aFields = new array( fldcount(), 4 ) aFields.fields() oExcel = new OleAutoClient( "Excel.Application" ) oExcel.Visible = .T. oExcel.DisplayAlerts = .F. oBook = oExcel.Workbooks.Add() oSheet = oBook.Worksheets( 1 ) oSheet.Name = "DbfToExcel" oSheet.Cells.Borders.LineStyle = .T. oExcel.ActiveWindow.SplitRow = 1 oExcel.ActiveWindow.SplitColumn = 0 oExcel.ActiveWindow.FreezePanes = .T. oExcel.ScreenUpdating = .F. nRow = 1 *// Write titles ( fields names ) and columns width for memos fields. for nCol = 1 to alen( aFields, 1 ) oCell = oSheet.Cells( nRow, nCol ) oCell.Value = aFields[ nCol, 1 ] oCell.NumberFormat = "@" oCell.Font.Bold = .T. oCell.Font.Italic = .T. oCell.Interior.ColorIndex = COLOR_YELLOW if aFields[ nCol, 2 ] = "M" &&// Memo. oCol = oSheet.Columns( nCol ) oCol.ColumnWidth = 50 endif next *// Write datas. do while .not. eof() nRow = nRow + 1 for nCol = 1 to alen( aFields, 1 ) oCell = oSheet.Cells( nRow, nCol ) fName = aFields[ nCol, 1 ] do case case aFields[ nCol, 2 ] = "C" &&// Characters. *// oCell.Value = ansi( &fName ) oCell.Value = &fName oCell.NumberFormat = "@" case aFields[ nCol, 2 ] = "D" &&// Date. oCell.Value = dtoc( &fName ) oCell.NumberFormat = "jj/mm/aaaa" &&// French. case aFields[ nCol, 2 ] = "L" &&// Bool. if &fName oCell.Value = "vrai" else oCell.Value = "faux" endif case aFields[ nCol, 2 ] = "M" &&// Memo. *// oCell.Value = ansi( &fName ) oCell.Value = &fName oCell.NumberFormat = "@" oCell.WrapText = .T. case aFields[ nCol, 2 ] = "N" &&// Numeric. if aFields[ nCol, 4 ] = 0 cFormat = "0" else *// cFormat = "0." + replicate( "0", aFields[ nCol, 4 ] ) &&// French if not good with coma. cFormat = "0," + replicate( "0", aFields[ nCol, 4 ] ) &&// French. endif oCell.Value = &fName oCell.NumberFormat = cFormat otherwise oCell.Value = "*** Error field type << " + aFields[ nCol, 2 ] + " >> not found." endcase if mod( nRow, 2 ) <> 0 oCell.Interior.ColorIndex = COLOR_GRAY15 endif next skip enddo use oSheet.UsedRange.Columns.AutoFit() oExcel.ScreenUpdating = .T. if val( oExcel.Version ) < 12 oBook.SaveAs( Excel_File11 ) else oBook.SaveAs( Excel_File12 ) endif *//oBook.Close( .T. ) *//oExcel.Quit() oExcel = null release cPath release cTable release fName return | |