Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
Getting users some control
Message
 
General information
Forum:
Visual FoxPro
Category:
Reports & Report designer
Miscellaneous
Thread ID:
00614042
Message ID:
00614137
Views:
30
>>Nadya,
>>>BTW, Daniel, you have a typo in the first message text. You said vale instead of value :)
>>
>>Nothing escapes you ;-)
>
>Hi, Daniel.
>
>Got it working. Works great, thanks a lot. I made one minor fix, which I mentioned for table with different alias.

Ok, another question: Is it possible to turn it to Normal excel view not the Preview?

>Here is a program with this minor fix. I use Move.avi instead of FileMove, I guess, both are similar.
>
>************************************************
>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 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, 3)
>	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 m.tnMode = cnToExcelPreview
>	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
>
>lnRetVal = 0
>
>declare Sleep in WIN32API integer nMillisecs
>
>*-- perform output/save actions based on
>do case
>case tnMode = cnToExcelNoShow
>*-- save formatted Excel file
>	oXLS.ActiveSheet.saveas(lcExcelFile, xlWorkbookNormal)
>	oXLS.application.quit
>	lnRetVal = iif(file(lcExcelFile), 0, -35)
>case 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
>endcase
>
>*-- remove message
>if vartype(m.loMessage) = "O" and not isnull(loMessage)
>	release loMessage
>endif
>
>if not empty(m.lcDbc)
>	set database to (m.lcDbc)
>else
>	set database to
>endif
>return m.lnRetVal
>*-- EOF Method QuickReport -------------------------------------------------------------------------------
If it's not broken, fix it until it is.


My Blog
Previous
Next
Reply
Map
View

Click here to load this message in the networking platform