I already thought that I more or less figured out the conversion dbf in Excel. But here again there was an old problem, seemingly out of the blue. dbf-file the most common. I want to just write dbf-file in Excel with the given names of speakers and an error of execution.
I am your function slightly modified so that it did not pass the line at the start of Excel-file. Yet there is something slightly different because an error occurred. Here is the text that I use:
Code: Select all
*******************
******** DBF => XLS
*******************
* -------------
FUNCTION DC_WorkArea2Excel( cExcelFile, nOrientation, lDisplayAlerts, ;
lVisible, aFields, lAutoFit, cDateFormat, aFieldEvals, ;
cPassword, lFreezeRow1, lCsvFallBack, aColumnNames )
LOCAL oExcel, oBook, oSheet, nRow, aStru, i, cHeader, ;
cFieldName, cFieldType, nFieldLen, nFieldDec, cFormat, ;
xValue, GetList[0], GetOptions, oDlg, nCount := 0, ;
cDbfName, nKeyCount, oProgress, lStatus := .t., aData, ;
cRow, cColumns, cRange, aRow, bError, aStru2, nFound, ;
cFieldValue, nFieldBlock
DEFAULT nOrientation := xlLandscape, ;
lDisplayAlerts := .f., ;
lVisible := .f., ;
lAutoFit := .f., ;
cDateFormat := "US", ; // US, USSHORT, EURO, EUROSHORT, or send custom?
aFieldEvals := {}, ;
cExcelFile := DC_Path(AppName(.t.)) + 'worksheet.xls', ;
lFreezeRow1 := .t., ;
lCsvFallBack := .f.
// aFieldEvals -> {{FIELDNAME,CodeBlock},....} Code blocks to evaluate for specific fields
#if XPPVER > 1900000
// Create the "Excel.Application" object
IF '.CSV' $ Upper(cExcelFile)
RETURN DC_WorkArea2Csv(cExcelFile)
ENDIF
oExcel := CreateObject("Excel.Application")
IF Empty( oExcel )
IF lCsvFallBack
DCMSGBOX 'Excel is not installed. Create CSV file instead?' YESNO TO lStatus
IF lStatus
RETURN DC_WorkArea2Csv(cExcelFile)
ELSE
RETURN .f.
ENDIF
ELSE
DC_WinAlert( "Excel is not installed" )
ENDIF
RETURN .f.
ENDIF
#else
DC_WinAlert('This feature is available in Xbase++ 1.9 and later only!')
RETURN .f.
#endif
IF upper(cDateFormat) = "USSHORT"
cDateFormat := "m\/d\/yyyy;@"
ELSEIF upper(cDateFormat) = "US"
cDateFormat := "mm\/dd\/yyyy;@"
ELSEIF upper(cDateFormat) = "EUROSHORT"
cDateFormat := "d\/m\/yyyy;@"
ELSEIF upper(cDateFormat) = "EURO"
cDateFormat := "dd\/mm\/yyyy;@"
ENDIF
// Avoid message boxes such as "File already exists". Also,
// ensure the Excel application is visible.
oExcel:DisplayAlerts := lDisplayAlerts
oExcel:visible := lVisible
// Add a workbook to the Excel application. Query for
// the active sheet (sheet-1) and set up page/paper
// orientation.
cDbfName := dbInfo(DBO_FILENAME)
IF cDbfName = '<CURSOR>'
nKeyCount := RecCount()
ELSE
nKeyCount := DC_KeyCount()
ENDIF
@ 0,0 DCSAY 'Creating Excel Worksheet: ' + cExcelFile SAYSIZE 0
@ 1,0 DCPROGRESS oProgress SIZE 50,1 ;
TYPE XBPSTATIC_TYPE_TEXT ;
COLOR GRA_CLR_CYAN, GRA_CLR_WHITE ;
PERCENT ;
PERCENTCOLOR GRA_CLR_RED ;
RADIUS 20 ;
OUTLINE ;
DYNAMIC ;
EVERY Int(nKeyCount/100)
@ 3,0 DCPUSHBUTTON CAPTION 'Cancel' SIZE 9,1.2 ACTION {||lStatus:=.f.}
DCGETOPTIONS NORESIZE ALWAYSONTOP _PIXEL .f.
DCREAD GUI FIT TITLE 'Exporting to Excel' ;
MODAL EXIT PARENT @oDlg OPTIONS GetOptions NOAUTORESTORE
oBook := oExcel:workbooks:Add()
oSheet := oBook:ActiveSheet
oSheet:PageSetup:Orientation := nOrientation
DC_DbGoTop()
nRow := 1
// Feed in the data from the table to the Cells
// of the sheet.
aStru := dbStruct()
IF Valtype(aFields) == 'A'
aStru2 := AClone(aStru)
aStru := Array(0)
FOR i := 1 TO Len(aFields)
cFieldName := Upper(Alltrim(aFields[i]))
nFound := AScan(aStru2,{|a|Upper(a[1])==cFieldName})
IF nFound > 0
AAdd( aStru, aStru2[nFound] )
ENDIF
NEXT
ENDIF
aFields := Array(0)
FOR i := 1 TO Len(aStru)
cFieldName := aStru[i,1]
nFieldDec := aStru[i,4]
IF Valtype(&(cFieldName)) $ 'NF'
IF nFieldDec == 0
cFormat := '0'
ELSE
cFormat := '0.' + Repl('0',nFieldDec)
ENDIF
ELSEIF Valtype(&(cFieldName))=='D'
cFormat := cDateFormat
ELSEIF Valtype(&(cFieldName)) $ 'CM'
cFormat := "@" // Preserves leading 0s on strings that look like numbers
ELSE
cFormat := ''
ENDIF
AAdd(aFields,{cFieldName,cFieldName,cFormat})
NEXT
FOR i := 1 TO Len(aFields)
IF Len(aFields[i]) < 3
ASize(aFields[i],3)
ENDIF
IF Valtype(aColumnNames) == 'A' .AND. Len(aColumnNames) == Len(aFields)
cHeader := aColumnNames[i]
ELSE
cHeader := aFields[i,2] // Чтобы не писала имена полей
ENDIF
IF !Empty(cHeader)
oSheet:Cells(nRow,i):Value := cHeader
ENDIF
cFormat := aFields[i,3]
IF !Empty(cFormat)
* MsgBox(cFormat) // Отладка. Функция преобразования xls=>dbf формирует файл со странным форматом числовых полей
cFormat := '0.' + Repl('0',nFieldDec)
oSheet:Columns(i):NumberFormat := cFormat // <<<===== IN THIS LINE, AN ERROR OCCURS
ENDIF
NEXT
aRow := Array(Len(aStru))
aData := Array(0)
cColumns := Get_Excel_Column_ID(Len(aRow))
nRow += 2
DO WHILE !DC_Eof() .AND. lStatus
DC_CompleteEvents()
DC_GetProgress(oProgress,nCount++,nKeyCount)
FOR i := 1 TO Len(aFields)
cFieldName := aFields[i,1]
cFieldValue := &(cFieldName)
nFieldBlock := aScan(aFieldEvals,{|a|upper(a[1])==upper(cFieldName)})
IF nFieldBlock > 0
cFieldValue := Eval(aFieldEvals[nFieldBlock,2],cFieldValue)
ENDIF
IF Valtype(cFieldValue) == 'D'
aRow[i] := Dtoc(cFieldValue)
ELSEIF Valtype(cFieldValue) $ 'CM'
aRow[i] := Trim(cFieldValue)
ELSE
aRow[i] := cFieldValue
ENDIF
NEXT
AAdd( aData, AClone(aRow) )
nRow++
DC_DbSkip(1)
ENDDO
*cRange := 'A3:' + cColumns + Ltrim(Str(nRow-1))
cRange := 'A2:' + cColumns + Ltrim(Str(nRow-2)) // Чтобы не было пустой строки
oDlg:destroy()
oSheet:Range(cRange):Value := aData
// Force a reformat for the size of the first column
IF lAutoFit
FOR i := 1 TO Len(aFields)
oSheet:Columns(i):AutoFit()
NEXT
ENDIF
IF lFreezeRow1
oSheet:Range("A1:A1"):EntireRow:Font:Bold := .t.
oSheet:Activate()
oSheet:Application:ActiveWindow:SplitRow := 1
oSheet:Application:ActiveWindow:FreezePanes := .T.
ENDIF
bError := ErrorBlock( {|e| Break(e) } )
BEGIN SEQUENCE
// Save workbook as ordinary excel file.
oBook:SaveAs(cExcelFile,xlWorkbookNormal,cPassword)
RECOVER
END SEQUENCE
ErrorBlock(bError)
oSheet:destroy()
oBook:close()
oBook:destroy()
// Quit Excel
oExcel:Quit()
oExcel:Destroy()
RETURN .t.
* ------------
[/size]
Here, the database:
http://lc.kubagro.ru/Dima/Klas_res.dbf
The Program:
Code: Select all
aColumnNames := {}
AADD(aColumnNames, 'Код класса')
AADD(aColumnNames, 'Наименование класса')
AADD(aColumnNames, 'Начальный ресурс класса')
AADD(aColumnNames, 'Остаток ресурса класса')
AADD(aColumnNames, 'Количество объектов, назначенных на класс')
AADD(aColumnNames, 'Суммарное сходство назначенных объектов')
AADD(aColumnNames, 'Суммарные затраты на назначенные объекты')
AADD(aColumnNames, 'Средневзвешенное удельное сходство')
AADD(aColumnNames, 'Средний на объект уровень сходства')
AADD(aColumnNames, 'Средние на объект затраты')
*DC_WorkArea2Excel( cExcelFile, nOrientation, lDisplayAlerts, ;
* lVisible, aFields, lAutoFit, cDateFormat, aFieldEvals, ;
* cPassword, aColumnNames )
cExcelFile = M_ApplsPath+"\Inp_data\Klas_res.xls"
CLOSE ALL
USE Klas_res EXCLUSIVE NEW;N_Cls = RECCOUNT()
SELECT Klas_res
DC_DbGoTop()
DC_WorkArea2Excel( cExcelFile ,,,,,,,,,,, aColumnNames )
[/size]
