dbf to excel

[rdonnay]

It looks like I need to make some adjustments to the DC_WorkArea2Excel() function to give you the option of different header names. I am on vacation this week but I'll try to find the time. Meanwhile, you can look at the source code in _DCFUNCT.PRG and maybe modify it to your needs.

[zumba]

Hi

A previous version had this in.

Ccomment out lines 4260 - 4293 in _dcfunct.prg.

Add something like this to your source:
aFields := { ;
{'ENO' , "Number", nil},;
{'SURNAME' , "Surname and Initials", nil},;
{'TOTAL' , "Total Deductions",nil} ,;
{'LOAN' , "Loan Amount", nil} ,;
{'ADMIN' , "Admin Amount",nil} ,;
{'INITIATION', "Initiation Amount",nil} ,;
{'CHANGE' , "Change",nil} ;
}
Regards

Nico

[BruceN]

the sheet:cell code worked perfectly.. .thanks.

for this case opening is fine... customer just needs to create spreadsheet and email it to a vendor. doesn't do anything to/with it.

as always... thanks.

bruce

[Eugene Lutsenko]

Roger Donney solved this problem:
http://bb.donnay-software.com/donnay/vi ... f=2&t=1408
The names of the columns Excel-file must be in the values of the array elements: aColumnNames:

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         // Здесь возникает ошибка
  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]