Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
Getting users some control
Message
 
 
To
01/02/2002 11:58:00
General information
Forum:
Visual FoxPro
Category:
Reports & Report designer
Miscellaneous
Thread ID:
00614042
Message ID:
00614131
Views:
23
>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.
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