I am guessing that you have an older version of eXpress++.
This problem was resolved several years ago in eXpress++ code.
Attached is Worksheet.xls created from the most current version.
You need to modify your DC_WorkArea2Excel() function in _DCFUNCT.PRG.
Then you need to rebuild your DCLIPX.DLL by running BUILD19_SL1.BAT or BUILD20.BAT
Code: Select all
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, cValue, aScope
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
aScope := DC_SetScopeArray()
@ 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)
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]
IF Valtype(cFieldName) == 'C'
cFieldValue := &(cFieldName)
nFieldBlock := aScan(aFieldEvals,{|a|upper(a[1])==upper(cFieldName)})
IF nFieldBlock > 0
cFieldValue := Eval(aFieldEvals[nFieldBlock,2],cFieldValue)
ENDIF
ELSEIF Valtype(cFieldName) == 'B'
cFieldValue := Eval(cFieldName)
ENDIF
IF Valtype(cFieldValue) == 'D'
aRow[i] := Dtoc(cFieldValue)
ELSEIF Valtype(cFieldValue) = 'C'
aRow[i] := Trim(cFieldValue)
ELSEIF Valtype(cFieldValue) = 'M'
cValue := Substr(Trim(cFieldValue),1,1024)
aRow[i] := cValue
ELSE
aRow[i] := cFieldValue
ENDIF
NEXT
AAdd( aData, AClone(aRow) )
nRow++
DC_DbSkip(1)
IF !Empty(aScope) .AND. !(Recno()$aScope)
EXIT
ENDIF
ENDDO
cRange := 'A3:' + cColumns + Ltrim(Str(nRow-1))
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
IF '.XLSX' $ Upper(cExcelFile)
// Save workbook as ordinary excel file.
oBook:SaveAs(cExcelFile,xlOpenXMLWorkbook,cPassword)
ELSE
// Save workbook as ordinary excel file
oBook:SaveAs(cExcelFile,xlWorkbookNormal,cPassword)
ENDIF
RECOVER
END SEQUENCE
ErrorBlock(bError)
oSheet:destroy()
oBook:close()
oBook:destroy()
// Quit Excel
oExcel:Quit()
oExcel:Destroy()
RETURN .t.