Plateforme Level Extreme
Abonnement
Profil corporatif
Produits & Services
Support
Légal
English
Printing a Grid...
Message
 
 
À
01/06/2006 01:15:28
Dorin Vasilescu
ALL Trans Romania
Arad, Roumanie
Information générale
Forum:
Visual FoxPro
Catégorie:
Gestionnaire de rapports & Rapports
Versions des environnements
Visual FoxPro:
VFP 9 SP1
OS:
Windows XP SP2
Network:
Windows 2000 Server
Database:
Visual FoxPro
Divers
Thread ID:
01126303
Message ID:
01482754
Vues:
153
>>Is there an easy way to print a grid?
>
>You can export to Excel and print from there
>Try this utility of mine. It knows subtotals and extra header rows if needed.
>
>
>PROCEDURE grid2xls
>LPARAMETERS oGrid, oParameters
>*!* Program: grid2xls
>*!* Author: Dorin Vasilescu
>*!* Copyright: freeware
>*!* Description: save table/cursor data to Excel using a grid as reference 
>*							( data ,columns, formatting, headers, DynamicBackColor)
>*
>* Parameters:
>
>* oGrid:	 	grid reference
>* oParameters	parameters objects, collection class, used to pass header rows, SaveAs file name, Subtotals
>*
>*Example:
>*	- headers:
>*	 	oP = NEWOBJECT('Collection')
>*		oP.Add(NEWOBJECT('Empty'),'headers') 		&&headers item, empty class
>*		AddProperty(oP.Item(1),'aHeaders[2,8]',.f.)	&&aHeaders, array property, 8 columns
>*		WITH oP.Item(1)
>*			* 1st header 
>*		    .aHeaders[1,1] = 'Header 1 text:'
>*   		.aHeaders[1,2] = 1					&&row
>*			.aHeaders[1,3] = 1					&&column
>*			.aHeaders[1,4] = 'Arial'			&&FontName
>*			.aHeaders[1,5] = 16					&&FontSize
>*			.aHeaders[1,6] = .T.				&&FontBold
>*			.aHeaders[1,7] = .T.				&&FontItalic
>*			*2nd header
>*			.aHeaders[2,1] = 'Header 2 text'
>*			.aHeaders[2,2] = 4    				&&row
>*			.aHeaders[2,3] = 4 				 	&&column
>*			.aHeaders[2,8] = -4108				&&Alignment ( xlCenter )
>*		ENDWITH
>*
>*	- SaveAs filename
>*		
>*		ADDPROPERTY(oP,'fileName','C:\Windows\Temp\test.xls')
>*
>*
>*	- subtotals (using comma delimited values)
>*
>*		ADDPROPERTY(oP,'subtotals','1,3,4,5')
>*										
>*			first value ( 1 )   : group by column
>*			next values (3,4,5) : summed columns  
>*
>*
>*	Call : grid2xls( oGrid, oP )
>*	
>*	OR	 : grid2xls( oGrid )	
>
>#DEFINE xlLeft		-4131	
>#DEFINE xlCenter	-4108	
>#DEFINE xlRight		-4152	
>#DEFINE xlSum		-4157
>#DEFINE PIXEL_PER_UNIT	7.5
>#DEFINE MSG_ROWS_PROCESSED	"Inregistrari exportate: "
>
>#IF .f.
>	LOCAL oGrid as Grid 
>	LOCAL oParameters as Collection 
>#ENDIF 
>
>LOCAL oExcel as 'Excel.Application'
>oExcel = .null.
>
>TRY 
>	oExcel = CREATEOBJECT('Excel.Application')
>CATCH 
>	MESSAGEBOX('Eroare initializare Excel.' + CHR(13) + 'Posibil neinstalat' ;
>		, 0+16+4096 , 'Start Excel', 10000)
>ENDTRY 
>
>*check if we continue or not
>IF ISNULL(oExcel)
>	RETURN 
>ENDIF 
>IF NOT VARTYPE(oGrid) = 'O'
>	RETURN 
>ELSE 
>	IF NOT oGrid.BaseClass == 'Grid'
>		RETURN 
>	ENDIF 
>ENDIF 
>
>
>
>LOCAL i, iItem, nFirstDataRow, nRowsProcessed, lHasParams, nHeaderRow, oParmObj, oColumn
>LOCAL cHdItem, nRow, nColumn, nRecno, cRange, nDBColor, nDFColor, oCell
>LOCAL oCols		&&columns collection, needed to sort by ColumnOrder
>
>nHeaderRow = 1
>nFirstDataRow = 2 	
>nRowsProcessed = 0
>lHasParams = (TYPE('oParameters') = 'O')
>oCols = NEWOBJECT('Collection')
>oCols.KeySort = 2
>
>IF oGrid.RecordSourceType = 1
>	SELECT (oGrid.RecordSource)
>ELSE
>	*alias needed to be selected before calling 
>ENDIF 
>
>nRecno = RECNO()
>
>*add columns ref to columns collection
>FOR i = 1 TO oGrid.ColumnCount
>	oCols.Add(oGrid.Columns(i), PADL(STR(i,3),3,'0'))
>ENDFOR 
>
>oExcel.DisplayAlerts = .f. 
>oExcel.ScreenUpdating = .f. 
>oExcel.Workbooks.Add
>FOR i=2 TO oExcel.Sheets.Count   
>	oExcel.Sheets(2).Delete 
>ENDFOR 
>
>*set columns width/font
>i = 0
>FOR EACH oColumn IN oCols 
>	i = i + 1 
>	WITH oColumn  
>       	oExcel.Columns(i).Font.Name = .FontName
>       	oExcel.Columns(i).Font.Size = .FontSize
>      	oExcel.Columns(i).Font.Bold = .FontBold 
>       	oExcel.Columns(i).ColumnWidth = (.Width + 2*.Parent.GridLineWidth) / PIXEL_PER_UNIT
>	ENDWITH 
>ENDFOR 
>
>IF lHasParams
>	IF PEMSTATUS(oParameters,'GetKey',5)
>		iItem = oParameters.GetKey('headers')
>	ELSE 
>		iItem = 0
>	ENDIF 
>	
>	IF iItem <> 0
>		oParamObj = oParameters.Item(iItem)
>	ENDIF 
>	
>	IF TYPE('oParamObj.aHeaders[1,1]') <> 'U'
>	
>		WITH oParamObj
>
>			FOR i=1 TO ALEN(.aHeaders,1)
>				*verify header item type
>				IF TYPE('.aHeaders[i,1]') = 'L'
>					cHdItem = ''
>				ELSE 
>					cHdItem = .aHeaders[i,1]
>				ENDIF 
>				*verify header item row location type
>				IF TYPE('.aHeaders[i,2]') <> 'N'
>					nRow = i
>				ELSE 
>					nRow = .aHeaders[i,2]
>				ENDIF 
>				*verify header item column location type
>				IF TYPE('.aHeaders[i,3]') <> 'N'
>					nColumn = 1
>				ELSE 
>					nColumn = .aHeaders[i,3]
>				ENDIF 
>				*set header size, if necessary
>				IF nFirstDataRow < nRow + 2
>					nFirstDataRow = nRow + 2
>				ENDIF 
>
>				oExcel.Cells(nRow,nColumn).Select 
>				oExcel.Selection.Value = cHdItem
>				
>				IF TYPE('.aHeaders[i,4]') = 'C'
>					oExcel.Selection.Font.Name = .aHeaders[i,4]
>				ENDIF 
>			
>				IF TYPE('.aHeaders[i,5]') = 'N'
>					oExcel.Selection.Font.Size = .aHeaders[i,5]
>				ENDIF 
>			
>				oExcel.Selection.Font.Bold = .aHeaders[i,6]
>				oExcel.Selection.Font.Italic = .aHeaders[i,7]
>			
>				IF TYPE('.aHeaders[i,8]') = 'N'
>					oExcel.Selection.HorizontalAlignment = .aHeaders[i,8]
>				ENDIF 
>			ENDFOR 
>		ENDWITH 
>	ENDIF 
>ENDIF 
>
>*Column Headers
>nHeaderRow = nFirstDataRow - 1
>i = 0
>FOR EACH oColumn IN oCols 
>	i = i + 1 
>	oExcel.Rows(nHeaderRow).RowHeight = oGrid.HeaderHeight 
>	WITH oColumn  
>		oExcel.Cells(nHeaderRow,i).Select
>		oExcel.Selection.Value = .Objects(1).Caption
>		oExcel.Selection.HorizontalAlignment = xlCenter
>       	oExcel.Selection.VerticalAlignment = xlCenter
>       	oExcel.Selection.WrapText = .t.
>       	oExcel.Columns(i).ColumnWidth = ;
>       		.Width / PIXEL_PER_UNIT
>	ENDWITH 
>ENDFOR 
>
>WAIT WINDOW MSG_ROWS_PROCESSED + STR( nRowsProcessed ) NOWAIT 
>
>SCAN 
>	i = 0
>	FOR EACH oColumn IN oCols
>		i = i + 1 
>		WITH oColumn 
>		
>			IF NOT EMPTY(.ControlSource)
>
>				oCell = oExcel.Cells(nFirstDataRow + nRowsProcessed, i)
>				IF NOT EMPTY(EVALUATE(.ControlSource)) OR TYPE(.ControlSource) = 'N'
>					oCell.Value = EVALUATE(.ControlSource)
>				ENDIF 
>				
>				IF NOT EMPTY(.DynamicBackColor)
>					nDBColor = EVALUATE(.DynamicBackColor)
>					IF  nDBColor <> oGrid.BackColor 
>						oCell.Interior.Color = nDBColor 
>					ENDIF 
>
>				ENDIF 
>
>				IF NOT EMPTY(.DynamicForeColor)
>					nDFColor = EVALUATE(.DynamicForeColor)
>					IF  nDFColor <> oGrid.ForeColor 
>						oCell.Font.Color = nDFColor 
>					ENDIF 
>
>				ENDIF 
>
>			ENDIF  			
>
>		ENDWITH 
>
>	ENDFOR 
>
>	nRowsProcessed = nRowsProcessed + 1 
>	IF MOD(nRowsProcessed,SET("Odometer")) = 0
>		WAIT WINDOW MSG_ROWS_PROCESSED + STR( nRowsProcessed ) NOWAIT 
>	ENDIF 
>
>ENDSCAN 
>
>IF oGrid.ColumnCount <= 26
>	cRange = 'A'+TRANSFORM(nHeaderRow) + ':' + CHR(64+oGrid.ColumnCount) ;
>		+ TRANSFORM(nHeaderRow + nRowsProcessed )
>ELSE 
>	cRange = 'A'+TRANSFORM(nHeaderRow ) + ':' ;
>		+ CHR(64+FLOOR(oGrid.ColumnCount/26)-1) ;
>		+ CHR(64+IIF(MOD(oGrid.ColumnCount,26)=0,26,MOD(oGrid.ColumnCount,26))) ;
>		+ TRANSFORM(nHeaderRow + nRowsProcessed )
>ENDIF 
>oExcel.Range(cRange).Select 
>oExcel.Selection.Borders(1).LineStyle = 1
>oExcel.Selection.Borders(2).LineStyle = 1
>oExcel.Selection.Borders(3).LineStyle = 1
>oExcel.Selection.Borders(4).LineStyle = 1
>oExcel.ActiveSheet.PageSetup.PrintTitleRows = "$1:$" + TRANSFORM(nHeaderRow)
>
>*subtotals, if needed, transmitted as comma delimited integers, first is group by column
>*from 2nd, summed columns  
>IF lHasParams AND TYPE('oParameters.subTotals') = 'C'
>	LOCAL ARRAY aTemp1[1], aTemp2[1]
>	LOCAL iGroupCount, iGroupColumn
>	iGroupCount = ALINES(aTemp,oParameters.subtotals,1,[,])
>	IF iGroupCount > 1
>		FOR i = 1 TO iGroupCount 
>			aTemp[i] = INT(VAL(aTemp[i]))
>		ENDFOR 
>		iGroupColumn = aTemp[1]
>		ADEL(aTemp,1)
>		DIMENSION aTemp[iGroupCount - 1]
>		oExcel.Selection.Subtotal(iGroupColumn, xlSum, @aTemp, .T., .F., .T.)
>	ENDIF 
>ENDIF 
>
>IF lHasParams AND TYPE('oParameters.fileName') = 'C'
>	oExcel.ActiveSheet.SaveAs(oParameters.fileName)
>ENDIF 
>
>IF nRecno > 0 AND nRecno <= RECCOUNT()
>	GOTO nRecno 
>ENDIF 
>oExcel.Cells(1,1).Select 
>oExcel.ScreenUpdating = .T.
>oExcel.Visible = .t. 
>WAIT CLEAR
>
Thanks.
If it's not broken, fix it until it is.


My Blog
Précédent
Répondre
Fil
Voir

Click here to load this message in the networking platform