回复 50楼 BlueGuy
方法一:用OLE打开Excel填数,VBA代码。方法二:将二维数组写成文本文件,从Excel导入。
授人以渔,不授人以鱼。
USE new IN 0 dbf2sheet("new", ADDBS(JUSTPATH(FULLPATH("new.dbf"))) + "Export.xlsx", "導出數據5") RETURN *------------------------------------ * 將數據表導出到Excel表格 * 參數:tcAlias -- 數據表工作區別名 * tcBook -- Excel 工作簿文件名(帶全路徑、擴展名) * tcSheet -- 工作表名稱(自動新增,不可與工作簿中已有Sheet重名) *------------------------------------ PROCEDURE dbf2sheet(tcAlias AS Character, tcBook AS Character, tcSheet AS Character) LOCAL loExcel AS Object LOCAL lnIndex AS Integer, lnRow AS Integer, lnCol AS Integer, leValue WAIT "正在導出數據,請稍候……" WINDOW NOWAIT loExcel = CREATEOBJECT("Excel.Application") WITH loExcel IF !FILE(tcBook) .WorkBooks.Add ELSE .WorkBooks.Open(tcBook) .Sheets.Add ENDIF .Sheets(1).Name = tcSheet .WorkSheets(tcSheet).Activate SELECT (tcAlias) FOR lnIndex = 1 TO FCOUNT(tcAlias) .Cells(1,lnIndex).Value = FIELD(lnIndex) NEXT .Rows(1).Font.Bold = .T. .Rows(1).HorizontalAlignment = 3 lnRow = 2 SCAN ALL FOR lnCol = 1 TO FCOUNT(tcAlias) leValue = EVALUATE(FIELD(lnCol)) DO CASE CASE VARTYPE(leValue) == "D" leValue = DTOC(leValue) CASE VARTYPE(leValue) == "L" leValue = IIF(leValue, '1', '0') ENDCASE .Cells(lnRow, lnCol).Value = leValue NEXT lnRow = lnRow + 1 ENDSCAN FOR lnIndex = 1 TO FCOUNT(tcAlias) .Columns(lnIndex).EntireColumn.AutoFit NEXT IF !FILE(tcBook) .ActiveWorkBook.SaveAs(tcBook) ELSE .ActiveWorkBook.Save ENDIF .Quit ENDWITH RELEASE loExcel WAIT CLEAR ENDPROC