Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
Getting users some control
Message
 
 
To
01/02/2002 15:46:17
General information
Forum:
Visual FoxPro
Category:
Reports & Report designer
Miscellaneous
Thread ID:
00614042
Message ID:
00614272
Views:
30
Hi Daniel,

I made some changes in the QuickReport program (see bellow). I asked the user, if she wants to have Excel with the file open, so she can modify it, and she answered, "No, I only need to print". I asked, does she want to preview and she answered "Yes, if I have this luxury". So, I invoke it with 2 as a parameter, but I now have 4 as an option, which would allow to modify report. I think, I will use this option myself :)

Once again, thanks a lot for this code. I guess, I would spend several days to design it myself, and now I got it working in less than an hour. And somebody else will have it in less than 5 min now :)

BTW, it's good to see code printed. I noticed, that I haven't updated description to this program yet. I'll do it, but would not post it again.
************************************************
procedure QuickReport
************************************************
*) Description.......: Formats and sends the content of the currently selected
*)                   : table/cursor to Excel using automation.
*)                   :
*)                   : The following modes are suppored:
*)                   :
*)                   :   1 = ToExcelNoShow
*)                   :   2 = ToExcelPreview
*)                   :   3 = ToPrinterNoShow (Excel file deleted)
*)                   :
*)                   : Returns: Numeric
*)                   :          0 if successful
*)                   :
*)                   :          If Error occurred:
*)                   :          -1 Parameter missing or invalid value
*)                   :          -2 Parameter missing or wrong type
*)                   :          -3 No table open in current work area
*)                   :
*  Calling Samples...: QuickReport(1, "c:\temp\customers.xls") && ToExcelNoShow
*                    : QuickReport(2)                          && ToExcelPreview
*                    : QuickReport(3)                          && ToPrinterNoShow
*If you want to launch it from a menu, you could add something like this to your startup.prg:

*-- Print currently selected table to Excel
*!*	DEFINE BAR 3 OF DevTools PROMPT "Print Table to Excel" SKIP FOR EMPTY(ALIAS())
*!*	ON SELECTION BAR 3 OF DevTools DO QuickReport(2)
*  Parameter List....: tnMode       - See above
*                    : tcOutputFile - Excel output file. Required for mode
*  Major change list.:
*--------------------------------------------------------------------------------------------------
lparameters tnMode, tcOutputFile

*-- possible values for
#define cnToExcelNoShow   1
#define cnToExcelPreview  2
#define cnToPrinterNoShow 3
#define cnToExcelNormal   4

#define clSuppressMessages .f.
#define ccCrLf  chr(13)+chr(10)

#define MB_ICONEXCLAMATION      48      && Warning message
#define MB_YESNO                4       && Yes and No buttons
#define MB_ICONQUESTION         32      && Warning query
#define IDYES                   6       && Yes button pressed

#define xlLeft                                        1
#define xlCenter                                  -4108
#define xlRight                                   -4152
#define xlLandscape                                   2
#define xlWorkbookNormal                          -4143  && used by SaveAs() to save in current version
#define cnInchesToPoints                             72
#define cnCentimetersToPoints   cnInchesToPoints / 2.54

#define icMessageBoxCaption "QuickReport - 1.02"
*-- adjust the following line!
* Nadya Nosonovsky 02/01/2002 11:31:31 AM  - AVI should be in a path
*#DEFINE ccAviFile "C:\Program Files\Microsoft Visual Studio\Common\Graphics\Videos\FileMove.avi"
#define ccAviFile "Move.avi" 
*-- check parameters ------------------------------------------------------------------------------
if vartype(m.tnMode)<> "N" or not between(m.tnMode, 1, 4)
	messagebox("QuickReport() - Parameter missing or wrong value." + ccCrLf + ;
		"Use one of the following:" + ccCrLf + ;
		"1 = ToExcelNoShow" + ccCrLf + ;
		"2 = ToExcelPreview" + ccCrLf + ;
		"3 = ToPrinterNoShow", ;
		MB_ICONEXCLAMATION, ;
		icMessageBoxCaption)
	return -1
endif

if m.tnMode = cnToExcelNoShow
*-- tcOutputFile must be passed
	if vartype(m.tcOutputFile)<>"C" or empty(m.tcOutputFile)
		messagebox("QuickReport() - Parameter  missing or wrong type.", ;
			MB_ICONEXCLAMATION, ;
			icMessageBoxCaption)
		return -2
	endif
endif

local lcExcelFile, lcMessageCaption, lcAviFile, lcAlias, lcDbc
local llFreeTable, loMessage, lnFields, i, lcFieldName, lcFieldCaption
local lcSafe, oXLS, lcTableName, lnRetVal, lnVfpHandle

lcAlias = alias()
lcTableName = lower(juststem(dbf(m.lcAlias)))
lcDbc = dbc()

if empty(m.lcAlias)
	messagebox("QuickReport() - No table open in current work area.",;
		MB_ICONEXCLAMATION,;
		icMessageBoxCaption)
	return -3
endif

do case
case m.tnMode = cnToExcelNoShow
	lcExcelFile = forceext(m.tcOutputFile, "XLS")
	lcMessageCaption = "Sending data to Excel..."
*lcAviFile = "CopyToExcel.avi"
case inlist(m.tnMode, cnToExcelPreview, cnToExcelNormal)
	lcExcelFile = addbs(sys(2023))+right(sys(3),8)+".XLS"
	lcMessageCaption = "Sending data to Excel..."
*lcAviFile = "CopyToExcel.avi"
case m.tnMode = cnToPrinterNoShow
	lcExcelFile = addbs(sys(2023))+right(sys(3),8)+".XLS"
	lcMessageCaption = "Sending data to printer..."
*lcAviFile = "CopyToPrinter.avi"
endcase

llFreeTable = empty(cursorgetprop("DATABASE"))

if not m.llFreeTable
	set database to (cursorgetprop("DATABASE"))
endif

*-- display message
if not clSuppressMessages
	loMessage = newobject("Animation", "Animation.vcx", "", ; && Now use Daniel's vcx class instead
		lcMessageCaption,;
		icMessageBoxCaption,;
		ccAviFile)
endif

lnFields = fcount()
dimension laFields[m.lnFields, 1]

for i = 1 to m.lnFields
	lcFieldName = lower(field(m.i))
	lcFieldCaption = ""
    
	if not m.llFreeTable
*-- get field caption from DBC 
*   Nadya Nosonovsky 02/01/2002 12:42:42 PM made a small fix to use tablename insted of alias
		lcFieldCaption = dbgetprop(m.lcTableName+"."+m.lcFieldName, "Field", "Caption")
	endif
	laFields[m.i, 1] = iif(empty(m.lcFieldCaption), proper(m.lcFieldName), m.lcFieldCaption)
endfor &&* i = 1 TO lnFields

*-- export selected fields to Excel
lcSafe = set("SAFETY")
set safety off
copy to (m.lcExcelFile) type xl5
if m.lcSafe='ON'
   set safety on
endif   

*--------------------------------------------------------------------------------------------------
*-- open Excel file and format worksheet
*--------------------------------------------------------------------------------------------------

oXLS = createobject("Excel.Application")
oXLS.application.Workbooks.open(lcExcelFile)
oXLS.application.DisplayAlerts = .f.

*-- get tablename
lcTableName = dbf()

*-- use name of alias if we're dealing with a cursor
if ".TMP" $ upper(m.lcTableName)
	lcTableName = "Cursor - " + alias()
endif

*-- set pageSetup properties
with oXLS.application.ActiveSheet.PageSetup
*.LeftHeader  = ""
	.CenterHeader = m.lcTableName
*.RightHeader = ""
	.LeftFooter   = icMessageBoxCaption
	.CenterFooter = "&P of &N"
	.RightFooter  = "&D - &T"
	.LeftMargin   = cnCentimetersToPoints * 1.9
	.RightMargin  = cnInchesToPoints * 0.27244094488189
	.TopMargin    = cnInchesToPoints * 0.47244094488189
	.BottomMargin = cnInchesToPoints * 0.47244094488189
	.HeaderMargin = cnInchesToPoints * 0.236220472440945
	.FooterMargin = cnInchesToPoints * 0.236220472440945
*.PrintHeadings = .f.
*.PrintGridlines = .f.
*.PrintComments = xlPrintNoComments
*.PrintQuality = 600
*.CenterHorizontally = .t.
*.CenterVertically = .t.
	.orientation = xlLandscape
*.Draft = .f.
*.PaperSize = xlPaperA4
*.FirstPageNumber = xlAutomatic
*.Order = xlDownThenOver
*.BlackAndWhite = .f.
	.zoom           = .f.
	.FitToPagesWide = 1
	.FitToPagesTall = .f.
	.PrintTitleRows = "$1:$1"    && repeats header on each page
endwith

*-- format column headings

*-- change column captions
for i = 1 to m.lnFields
	oXLS.Worksheets(1).range(oXLS.Worksheets(1).Cells(1, i), oXLS.Worksheets(1).Cells(1, i)).select
	oXLS.selection.value = laFields[m.i, 1]
endfor

*-- select first row
oXLS.Worksheets(1).range(oXLS.Worksheets(1).Cells(1, 1), oXLS.Worksheets(1).Cells(1, lnFields)).select
oXLS.selection.AutoFormat(1)

*-- format header row
with oXLS.selection.font
*.Name = "Arial"
*.Size = 12
	.Bold = .t.
	.Italic = .f.
	.shadow = .f.
endwith

with oXLS

*-- set width of each column to fit content
	.columns().EntireColumn.AutoFit
	.selection.Interior.ColorIndex = 15      && grey background
	.selection.HorizontalAlignment = xlLeft

endwith
*-- remove message
if vartype(m.loMessage) = "O" and not isnull(loMessage)
	release loMessage
endif
lnRetVal = 0

declare Sleep in WIN32API integer nMillisecs

*-- perform output/save actions based on
do case
case m.tnMode = cnToExcelNoShow
*-- save formatted Excel file
	oXLS.ActiveSheet.saveas(m.lcExcelFile, xlWorkbookNormal)
	oXLS.application.quit
	lnRetVal = iif(file(m.lcExcelFile), 0, -35)
case m.tnMode = cnToExcelPreview
*-- preview
	oXLS.visible=.t.	
    oXLS.application.DisplayAlerts = .t.
	oXLS.ActiveWindow.SelectedSheets.PrintPreview
*-- we don't close Excel after the user closes the
*-- preview window. Note that we haven't yet saved the
*-- Excel file. This allows the user to either discard
*-- the file or save it manually.

	declare integer FindWindow in Win32api string, string
	declare SetForegroundWindow in Win32api integer

	lnVfpHandle = FindWindow(.null., _screen.caption)

*-- bring VFP to the foreground before displaying the messagebox
	if m.lnVfpHandle <> 0
		SetForegroundWindow(m.lnVfpHandle)
	endif

	if messagebox("Do you want to save the Excel file?", MB_YESNO+MB_ICONQUESTION, icMessageBoxCaption) = IDYES
*-- nothing to do, keep Excel open and bring Excel to the foreground
		lnXlsHandle = FindWindow(.null., oXLS.caption)

		if m.lnXlsHandle <> 0
			SetForegroundWindow(m.lnXlsHandle)
		endif

	else
*-- user doesn't want to save the Excel file,
*-- so we quit Excel without saving and delete the file
		oXLS.DisplayAlerts = .f.
		oXLS.application.quit
		release oXLS
		Sleep(500)
		if file(m.lcExcelFile)
			delete file (m.lcExcelFile)
		endif
	endif

case m.tnMode = cnToPrinterNoShow
	oXLS.ActiveWindow.SelectedSheets.PrintOut()
*-- quit Excel without saving and delete the file
	oXLS.DisplayAlerts = .f.
	oXLS.application.quit
	release oXLS

	Sleep(500)

	if file(m.lcExcelFile)
		delete file (m.lcExcelFile)
	endif
case m.tnMode = cnToExcelNormal
*-- preview
	oXLS.visible=.t.	
    oXLS.application.DisplayAlerts = .t.
endcase

if not empty(m.lcDbc)
	set database to (m.lcDbc)
else
	set database to
endif
return m.lnRetVal
*-- EOF Method QuickReport -------------------------------------------------------------------------------
>Nadya,
>
>This will work. The only problem is that you have no control over Excel and what the user does. Basically, the PrintPreview() method is like a modal form. VFP doesn't process the next line until the user closes the preview. That's why I ask the user whether to save the file or not. If the user decides not to save the file, Excel is closed and the file is deleted from disk. If the s/he answers < Yes > then the Excel file is displayed in normal mode.
>
>If you simply display the Excel file then you have no (easy) control. If the user closes the Excel file, Excel asks if the user wants to save the file. If the user choses < No >, the file remains on disk. I find this rather confusing for the user.
>
>I hope this makes sense to you?
>
>>>Nadya,
>>>
>>>If you comment out the oXLS.ActiveWindow.SelectedSheets.PrintPreview line, it should simply display the sheet (when the oXls.visible = .t. executes).
>>>
>>>>
>>>>Ok, another question: Is it possible to turn it to Normal excel view not the Preview?
>>>>
>>
>>Thanks, Steve. I guess, I'll add another mode to this program.
>>
>>It didn't work. Immediatelly pops up a question "Do you want to save?", but Excel doesn't become visible
>>
>>Ok, made it work by just making it visible and not executing the rest of the code.
If it's not broken, fix it until it is.


My Blog
Previous
Reply
Map
View

Click here to load this message in the networking platform