>************************************************ >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 -------------------------------------------------------------------------------