=CopyAndFormat("c:\temp\test.xls")
I hope this gets you started.************************************************ PROCEDURE CopyAndFormat ************************************************ LPARAMETER tcExcelFile IF VARTYPE(tcExcelFile) "C" OR EMPTY(tcExcelFile) ??CHR(7) WAIT WINDOW NOWAIT "Parameter : Parameter missing or wrong type (Expecting 'C')" RETURN .F. ENDIF LOCAL lnRetVal lnRetVal = Copy2Xls(tcExcelFile) && copy selected table/cursor to Excel IF lnRetVal *-- an error occurred, inform user and cancel procedure MESSAGEBOX("Copy2Xls('" + tcExcelFile + "') failed. " +CHR(13)+; "Error: " + ALLTRI(STR(lnRetVal)) + CHR(13)+; "Procedure canceled.", 48) RETURN .f. ENDIF loXLS = CREATEOBJECT("Excel.Application") loWorkbook = loXLS.Application.Workbooks.Open(tcExcelFile) loWorkSheet = loXLS.Worksheets(1) FormatWorkSheet(loWorkSheet) && format worksheet loWorkBook.save() loXLS.visible = .t. *loXLS.application.quit *RELEASE loXLS RETURN *-- EOF Procedure CopyAndFormat -------------------------------------------------------------------
************************************************ PROCEDURE FormatWorkSheet ************************************************ *) Description.......: * Calling Samples...: * Parameter List....: * Major change list.: *-------------------------------------------------------------------------------------------------- LPARAMETERS toWorksheet *-- check parameter ------------------------------------------------------------------------------- IF VARTYPE(toWorksheet) "O" ??CHR(7) WAIT WINDOW NOWAIT "Parameter : Parameter missing or wrong type (Expecting 'O')" RETURN .F. ENDIF LOCAL lnRows, lnCols, i lnCols = AFIELDS(laFields) lnRows = RECCOUNT() #DEFINE xlLeft 1 #DEFINE xlCenter -4108 #DEFINE xlRight -4152 *-- format header row WITH toWorkSheet.Range(toWorkSheet.Cells(1, 1), toWorkSheet.Cells(1, lnCols)) .Font.Name = "Arial" .Font.Bold = .t. .Font.ColorIndex = 2 && white .Interior.ColorIndex = 41 && blue background *-- etc ENDWITH *-- format data WITH toWorkSheet.Range(toWorkSheet.Cells(2, 1), toWorkSheet.Cells(lnRows+1, lnCols)) .Font.Name = "Arial" .Font.Bold = .f. .Interior.ColorIndex = 15 && grey background *-- etc ENDWITH FOR i = 1 TO lnCols IF TYPE(laFields[i, 1]) = "N" *-- right align numeric columns toWorkSheet.Range(toWorkSheet.Cells(1, i), toWorkSheet.Cells(lnRows+1, i)).HorizontalAlignment = xlRight ELSE ENDIF toWorkSheet.Columns(i).EntireColumn.AutoFit ENDFOR &&* i = 1 TO lnFields RETURN *-- EOF Procedure FormatWorkSheet -----------------------------------------------------------------
************************************************ PROCEDURE Copy2Xls ************************************************ *) Description.......: Replacement for the native COPY TO TYPE XL5 command. *) : Excel 5 and Excel 95 have a limit of 16,383 rows per worksheet. *) : The limit in Excel 97 and Excel 2000 is 65,536 rows. *) : Since there is no TYPE XL8 command, VFP copies only the first 16,383 records. *) : *) : This program works around this limitation and allows to copy as many *) : records as the Excel version used on the user's machine supports. *) : *) : The solution is very simple: *) : 1. COPY TO TYPE CSV *) : 2. Open CSV file and SaveAs(tcExcelFile) using Automation *) : *) : Assumes that MS Excel (Excel 97 or higher) is installed on the *) : user's machine (well, it will also work with Excel 5.0 and 95, but of *) : course the limit of 16,383 will apply). *) : *) : Returns the number of exported records if successful, otherwise: *) : -1 = parameter missing or wrong type *) : -2 = no table open in current workarea *) : -3 = number of max. Excel rows exceeded *) : -4 = user didn't want to overwrite existing Excel file (SET SAFETY = ON) *) : * Calling Samples...: Copy2Xls("c:\temp\bidon.xls") * Parameter List....: tcExcelFile - Path\Filename of the Excel file to be created. * Major change list.: *-------------------------------------------------------------------------------------------------- LPARAMETER tcExcelFile #INCLUDE FoxPro.h #DEFINE xlWorkbookNormal -4143 && used by SaveAs() to save in current Excel version #DEFINE ccErrorNoParameter "Parameter : Parameter missing or wrong type (Expecting 'C')" #DEFINE ccErrorNoTableOpen "No table is open in the current workarea" #DEFINE ccErrorToManyRows "Number of records (" + ; ALLTRIM(TRANSFORM(lnRecords, "999,999,999")) +; ") exceed max. number of Excel rows (" -; ALLTRIM(TRANSFORM(lnXlsMaxNumberOfRows, "999,999,999"))+; ")" *-- check parameter IF VARTYPE(tcExcelFile) "C" OR EMPTY(tcExcelFile) ??CHR(7) WAIT WINDOW NOWAIT ccErrorNoParameter RETURN -1 ELSE tcExcelFile = ForceExt(tcExcelFile, "XLS") ENDIF *-- make sure that we have a table/cursor in the selected workarea IF EMPTY(ALIAS()) ??CHR(7) WAIT WINDOW NOWAIT ccErrorNoTableOpen RETURN -2 ENDIF LOCAL loXls, lnXlsMaxNumberOfRows, lnRecords, lnRetVal, lcTempDbfFile loXls = CREATEOBJECT("excel.application") *-- suppress Excel alerts and messages (similar to SET SAFETY OFF) loXls.DisplayAlerts = .f. *-- get number of max. rows from Excel. Before we can count the rows in a *-- worksheet, we need to add a workbook. loXls.workbooks.add() lnXlsMaxNumberOfRows = loXls.ActiveWorkBook.ActiveSheet.Rows.Count - 1 && 1 header row lnRecords = RECCOUNT() *-- check if the number or records exceeds Excel's limit IF lnRecords > lnXlsMaxNumberOfRows ??CHR(7) WAIT WINDOW NOWAIT ccErrorToManyRows *-- close Excel loXls.application.quit() RETURN -3 ENDIF *-- respect SET SAFETY IF SET("SAFETY") = "ON" AND FILE(tcExcelFile) IF MESSAGEBOX(tcExcelFile + " already exists, overwrite it?",; MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2) = IDNO *-- user selected so we bail out *-- close Excel loXls.application.quit() RETURN -4 ENDIF ENDIF lcTempDbfFile = AddBs(SYS(2023)) + SYS(3) + ".CSV" COPY TO (lcTempDbfFile) TYPE CSV lnRetVal = _TALLY *-- open exported CSV file loXls.Application.Workbooks.Open(lcTempDbfFile) *-- save as Excel file loXls.ActiveSheet.saveAs(tcExcelFile, xlWorkbookNormal) *-- delete CSV file IF FILE(lcTempDbfFile) DELETE FILE (lcTempDbfFile) ENDIF *-- close Excel loXls.application.quit() RETURN lnRetVal *-- EOF Copy2Xls ----------------------------------------------------------------------------------