Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
Good idea to place Excel spreadsheet control in VFP Form
Message
From
06/11/2008 01:12:54
 
 
To
06/11/2008 00:40:43
General information
Forum:
Visual FoxPro
Category:
ActiveX controls in VFP
Environment versions
Visual FoxPro:
VFP 9 SP2
OS:
Vista
Network:
Windows 2008 Server
Database:
MS SQL Server
Miscellaneous
Thread ID:
01359705
Message ID:
01360094
Views:
30
This message has been marked as a message which has helped to the initial question of the thread.
>Agnes,
>
>My main problem is this:
>
>The class records of different subjects have variable number of columns (grading criteria). For example, Math may have QUIZZES, RECITATION, PROJECTS, FINAL EXAM as columns. Another subject like Social Studies may have more columns such as QUIZZES, CLASS PARTICIPATION, TEAM WORK, HOMEWORK, UNIT TEST, FINAL EXAMS. Printing it using REPORT FORM will not 'center' it on their A3 paper.
>
>That is why I was thinking about outputting the results/data to Excel or HTML (whichever is easier to do) because they (Excel at least) have the printing capabilities such as 'shrink-to-fit' and 'centering' it.
>
>Thanks again.
>
>Dennis

The following procedure is based on code provided by Cetin Bazoz. Hope no errors were introducd during translation of comments. First you create a cursor which may have long column names then you call this routine. Perhaps you then leave the workbook open in Excel.
* This routine copies a cursor to an Excel spreasheet using ADODB.  Field names may be long.
PROCEDURE Cursor2Excel
LPARAMETERS tuWorkbook,tcWorksheetName,tcOpciones
* tuWorkbook: Always refers to a workbook, either by a file name or by reference to an object already in memory.
*	      Empty      -> Creates a new workbook without saving it
*	      Character  -> It is the name of an xls file, open or not
*	      Workbook -> Object in memory
* tcWorksheetName: If empty use default name
* tcOpciones: Can contain 'ADDITIVE' and/or 'SAVE'
	tuWorkbook = IIF(EMPTY(tuWorkbook),'',IIF(VARTYPE(tuWorkbook)='C',FORCEEXT(tuWorkbook,'xls'),tuWorkbook))	&& Puede ser .F.
	tcWorksheetName = IIF(EMPTY(tcWorksheetName),'',tcWorksheetName)
	tcOpciones = IIF(EMPTY(tcOpciones),'',UPPER(tcOpciones))	&& Puede ser .F.

	* Since it is slow to eliminate a table from a DBC we create a DBC in a temporary diectory which is deleted at the end
	LOCAL lnSelect,lcTempDBC,lcTempTable,lcXLSFile
	lnSelect	= SELECT()
	lcTempDir	= 'C:\Temp\' + SYS(2015) + '\'
	lcTempDBC   = lcTempDir + 'MyDatabase.dbc'
	lcTempTable = lcTempDir + 'MyTable.dbf'
	MD (lcTempDir)
	CREATE DATABASE (lcTempDBC)
	COPY TO (lcTempTable) DATABASE (lcTempDBC) NAME MyTable
	CLOSE DATABASES
	SELECT (lnSelect)

	* Code by Cetin
	Local loRS as AdoDB.Recordset,loRS2 as AdoDB.Recordset,loCon as AdoDB.Connection
	LOCAL loExcel AS Excel.Application,loWorkbook,loSheet
	loCon = CreateObject('ADODB.connection')
	loCon.ConnectionString = "Provider=VFPOLEDB;Data Source="+lcTempDBC
	loCon.Open()
	loRS = loCon.Execute('SELECT * FROM myTable')
llUsarDisconnectMe = .F.
IF llUsarDisconnectMe
	IF FILE('disconnectme.rst')
		ERASE disconnectme.rst
	ENDIF
	loRs.Save('disconnectme.rst')
	loRS2 = CreateObject('ADODB.Recordset')
	loRs2.Open('disconnectme.rst')
ELSE
ENDIF
	* Take it to Excel
	IF TYPE('tuWorkbook') = 'C'	&& We assume tuWorkbook is the name of a file, whether it exists or not
		* Open Excel
		loExcel = Createobject('Excel.Application')
		loExcel.WindowState = -4137  && xlMaximized 

		* Erase previous copy from disk if adding a sheet was not requested
		llBorrarOK = .T.
		IF NOT EMPTY(tuWorkbook) AND NOT 'ADDITIVE' $ tcOpciones AND FILE(tuWorkbook)
			* Use TRY/CATCH because file may be in use
			TRY
				ERASE (tuWorkbook)
			CATCH
				* Since we couldn't erase tile leave new workbook open without saving
				WAIT WINDOW NOWAIT 'Could not erase previous copy of ' + tuWorkbook
				llBorrarOK = .F.
			ENDTRY
		ENDIF

		* Create new file or open previous on ADDITIVE option
		llAbrirAnteriorOk = .F.
		llAbrirNuevoOK	  = .F.		
		IF 'ADDITIVE' $ tcOpciones
			TRY
				loExcel.Workbooks.Open(tuWorkbook)
				llAbrirAnteriorOK = .T.
			CATCH
				llAbrirNuevoOK	  = .F.		
			ENDTRY
			IF llAbrirAnteriorOK
				* Add a page at the end
				WITH loExcel.ActiveWorkbook.Worksheets
					.Add(.NULL.,.Item(.Count))
				ENDWITH
			ELSE
				* If cannot open workbook create a new one creamos uno nuevo
				TRY
					loExcel.Workbooks.Add()
					llAbrirNuevoOK = .T.
				CATCH
				ENDTRY
			ENDIF
		ELSE
			TRY
				loExcel.Workbooks.Add()
			CATCH
				llAbrirNuevoOK = .T.
			ENDTRY
		ENDIF
		
		* Reference to workbook
		loWorkbook = loExcel.ActiveWorkbook
		* Reference worksheet that receives data
		loSheet = loWorkbook.ActiveSheet

		* Bring data in
IF llUsarDisconnectMe
		loSheet.QueryTables.Add( loRS2, loExcel.Range("A1")).Refresh
ELSE
		WITH loSheet
			FOR ix=1 TO loRS.Fields.Count
				.Cells(1,m.ix).Value = PROPER(loRs.Fields(m.ix-1).Name)
			ENDFOR
			.Range('A2').CopyFromRecordSet( loRS )
		ENDWITH
ENDIF

		loExcel.Visible = .T.

		* Name worksheet if requested.  If name exists add 1,2,3 until 9
		IF !EMPTY(tcWorksheetName)
			FOR i = 0 TO 9
				lcNumero = IIF(i=0,'',TRANSFORM(i))
				TRY
					loSheet.Name = lcSheetName + lcNumero
					llOK = .T.
				CATCH
					llOK = .F.
				ENDTRY
				IF llOK
					EXIT
				ENDIF
			ENDFOR
		ENDIF

		* Save if appropriate
		IF !EMPTY(tuWorkbook)
			IF FILE(tuWorkbook)
				loWorkbook.Save()
			ELSE
				loWorkbook.SaveAs(tuWorkbook)
			ENDIF
		ENDIF

	ELSE
		* Asume tuWorkbook objeto-workbook
		
	ENDIF

	* Cleanup
	loRS.Close()
IF llUsarDisconnectMe
	loRS2.Close()
ENDIF
	loCon.Close()
	ERASE 'disconnectme.rst'
	ERASE (ADDBS(lcTempDir)+'*.*')
	RD (lcTempDir)
RETURN loExcel
Previous
Next
Reply
Map
View

Click here to load this message in the networking platform