Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
Export data to Excel file (using template)
Message
From
29/05/2001 05:20:31
 
 
To
28/05/2001 14:38:55
General information
Forum:
Visual FoxPro
Category:
Other
Miscellaneous
Thread ID:
00511978
Message ID:
00512100
Views:
35
Marc,

>I have data in a VFP cursor and want to create an Excel file with it.
>I used the COPY TO command but I also want to use a formatted Excel template.
>Someone knows the easiest way to do that? Thank you in advance.

The following few lines of code copy the selected table/cursor to Excel and format the sheet.
The code calls two procedures that are included. Copy2Xls() is a replacement for the native COPY TO command.
FormatWorkSheet() is a generic formatting procedure. It applies a different style to the heading row and to the data row.
It also right aligns numeric data. You can easily change the formatting according your needs. The easiest way to figure
out the VBA code is to record a macro in Excel then add and adjust
the code in FormatWorkSheet()

To test the code, simply select a table/cursor then type the following in the command window:
=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 ----------------------------------------------------------------------------------
Daniel
Previous
Reply
Map
View

Click here to load this message in the networking platform