FUNCTION Copy2Excel_All_files *********************************************************************************** * Create spreadsheets *********************************************************************************** CPA0010frm.StatusMessage.Caption ="Preparing to create Excel worksheets " This.Copy2Excel_CreateExcelObject( ) This.Copy2Excel_file1_apchck01( ) This.Copy2Excel_file3_apmast01( ) This.Copy2Excel_file2_apdist01( ) This.Copy2Excel_file4_salesytd( ) This.Copy2Excel_file5_invytd( ) RELEASE goExcel RETURN( .T. ) * FUNCTION Copy2Excel_CreateExcelObject #INCLUDE ..\Excel.h #INCLUDE ..\wconnect.h SET PROCEDURE TO wwUtils ADDITIVE SET CLASSLIB TO wwIPStuff ADDITIVE PUBLIC goExcel PUBLIC goSMTP goExcel = CREATEOBJECT( "Excel.Application" ) goExcel.Visible = .F. goSMTP = CREATEOBJECT("wwIPStuff") RETURN( .T. ) * FUNCTION Copy2Excel_file1_apchck01 CPA0010frm.StatusMessage.Caption ="Creating A/P Check Register Excel WorkBook" CLOSE DATABASES WITH goExcel .SheetsInNewWorkbook = 1 .Workbooks.Add .ActiveSheet.Name = "AP Checks" .ActiveWindow.DisplayGridlines = "FALSE" .ActiveWindow.DisplayHeadings = "FALSE" .Application.DisplayFormulaBar = "FALSE" .ActiveSheet.EnableCalculation = "True" .Cells.Font.Name = "Arial" .Cells.Font.Size = 10 **************************************** * Set column widths **************************************** .Columns(01).ColumnWidth = 0.50 .Columns(02).ColumnWidth = 8.00 .Columns(03).ColumnWidth = 9.00 .Columns(04).ColumnWidth = 11.00 .Columns(05).ColumnWidth = 45.00 .Columns(06).ColumnWidth = 10.00 .Columns(07).ColumnWidth = 13.00 .Columns(08).ColumnWidth = 14.00 .Columns(09).ColumnWidth = 0.50 **************************************** * Set row heights for heading lines **************************************** .Rows(01).RowHeight = 04 .Rows(02).RowHeight = 20 .Rows(03).RowHeight = 13.2 .Rows(04).RowHeight = 13.2 .Rows(05).RowHeight = 04 **************************************** * Build heading lines **************************************** SET CENTURY OFF lcSheetHeading = "Accounts Payable Check Register - For " + DTOC( This.dBeg_apchck01 ) + " - " + DTOC( This.dEnd_apchck01 ) This.Copy2Excel_Insert_value_to_range_or_cell( "b02:h02", "boxed", "center", "Arial Black", "plain", 11, lcSheetHeading ) * This.Copy2Excel_Insert_value_to_range_or_cell( "b03", "nobox", "left", "Arial", "bold", 10, "Check" ) This.Copy2Excel_Insert_value_to_range_or_cell( "c03", "nobox", "left", "Arial", "bold", 10, "Check" ) This.Copy2Excel_Insert_value_to_range_or_cell( "d03", "nobox", "left", "Arial", "bold", 10, "Vend." ) This.Copy2Excel_Insert_value_to_range_or_cell( "e03", "nobox", "left", "Arial", "bold", 10, "Vendor" ) This.Copy2Excel_Insert_value_to_range_or_cell( "f03", "nobox", "left", "Arial", "bold", 10, "Invoice" ) This.Copy2Excel_Insert_value_to_range_or_cell( "g03", "nobox", "left", "Arial", "bold", 10, "Reference" ) This.Copy2Excel_Insert_value_to_range_or_cell( "h03", "nobox", "right", "Arial", "bold", 10, "Check" ) * This.Copy2Excel_Insert_value_to_range_or_cell( "b04", "nobox", "left", "Arial", "bold", 10, "Number" ) This.Copy2Excel_Insert_value_to_range_or_cell( "c04", "nobox", "left", "Arial", "bold", 10, "Date" ) This.Copy2Excel_Insert_value_to_range_or_cell( "d04", "nobox", "left", "Arial", "bold", 10, "Number" ) This.Copy2Excel_Insert_value_to_range_or_cell( "e04", "nobox", "left", "Arial", "bold", 10, "Name" ) This.Copy2Excel_Insert_value_to_range_or_cell( "f04", "nobox", "left", "Arial", "bold", 10, "Number" ) This.Copy2Excel_Insert_value_to_range_or_cell( "g04", "nobox", "left", "Arial", "bold", 10, "Number" ) This.Copy2Excel_Insert_value_to_range_or_cell( "h04", "nobox", "right", "Arial", "bold", 10, "Amount" ) * This.Copy2Excel_Insert_value_to_range_or_cell( "b05:h05", "boxed", "center", "Arial Black", "plain", 10, " " ) ENDWITH ********************************************* * Populate the detail lines ********************************************* ln1stDetailRow = 6 lnRowNum = 6 lcFirstColumn = LTRIM( STR( ln1stDetailRow, 3, 0 ) ) lcLastColumn = LTRIM( STR( ln1stDetailRow, 3, 0 ) ) lcRange = lcFirstColumn + ":" + lcLastColumn goExcel.Rows( lcRange ).Select goExcel.ActiveWindow.FreezePanes = "TRUE" goExcel.Cells( 6,1 ).Select This.cFile2Use = "apchck01" This.cDestFile = This.cDestPath + This.cFile2Use USE ( This.cDestFile ) IN 0 IF RECCOUNT( ) = 0 goExcel.Cells( lnRowNum + 2, 2 ).Value = "Nothing to report, no transactions found." ELSE SET INDEX TO ( This.cDestFile ) SCAN ALL lcInvno = PADR( ALLTRIM( invno ), 8 ) lcRef = PADR( ALLTRIM( ref ), 10 ) WITH goExcel .Cells( lnRowNum, 2 ).NumberFormat = "@" .Cells( lnRowNum, 3 ).NumberFormat = "mm/dd/yy;@" .Cells( lnRowNum, 4 ).NumberFormat = "@" .Cells( lnRowNum, 5 ).NumberFormat = "@" .Cells( lnRowNum, 6 ).NumberFormat = "@" .Cells( lnRowNum, 7 ).NumberFormat = "@" .Cells( lnRowNum, 8 ).NumberFormat = "###,###.00" .Cells( lnRowNum, 2 ).HorizontalAlignment = "right" .Cells( lnRowNum, 3 ).HorizontalAlignment = "center" .Cells( lnRowNum, 4 ).HorizontalAlignment = "left" .Cells( lnRowNum, 5 ).HorizontalAlignment = "left" .Cells( lnRowNum, 6 ).HorizontalAlignment = "left" .Cells( lnRowNum, 7 ).HorizontalAlignment = "left" .Cells( lnRowNum, 2 ).Value = checkno .Cells( lnRowNum, 3 ).Value = checkdate .Cells( lnRowNum, 4 ).Value = vendno .Cells( lnRowNum, 5 ).Value = company .Cells( lnRowNum, 6 ).Value = lcInvno .Cells( lnRowNum, 7 ).Value = lcRef .Cells( lnRowNum, 8 ).Value = aprpay ENDWITH lnRowNum = lnRowNum + 1 ENDSCAN CPA0010frm.StatusMessage.Caption ="Calculating totals for A/P Check Register" WITH goExcel .Cells( lnRowNum, 8 ).NumberFormat = "###,###.00" .Cells( lnRowNum, 7 ).Value = "Total" .Cells( lnRowNum, 8 ).Select lnFirstDataRow = ln1stDetailRow lnLastDataROw = lnRowNum - 1 lcTotalCell = "G" + LTRIM( STR( lnRowNum, 4,0 ) ) lnFirstDataCell = "H" + LTRIM( STR( lnFirstDataRow, 4, 0 ) ) lnLastDataCell = "H" + LTRIM( STR( lnLastDataROw, 4, 0 ) ) lcFormulaCell = "H" + LTRIM( STR( lnRowNum, 4,0 ) ) lcFormula = "=SUM(" + lnFirstDataCell + ":" + lnLastDataCell + ")" .ActiveCell.Formula = lcFormula ** .Cells( lnRowNum, 8 ).Calculate ** .Application.Calculate lcRange = lcTotalCell + ":" + lcFormulaCell .Range( lcRange ).Font.Bold = "TRUE" ENDWITH ENDIF goExcel.Range("A1").Select lcExcelFileName = "Crown Meat AP Checks WE" + DTOS( DATE( ) ) lcExcelSaveName = This.cExcelPath + lcExcelFileName lcDeleteName = '"' + lcExcelSaveName + '.xls"' IF FILE ( lcDeleteName ) ERASE &lcDeleteName ENDIF goExcel.ActiveWorkbook.Saveas( lcExcelSaveName, xlExcel7 ) CLOSE DATABASES CPA0010frm.StatusMessage.Caption ="Completed A/P Check Register Excel WorkBook" RETURN( .T. ) * * * FUNCTION Copy2Excel_Insert_value_to_range_or_cell LPARAMETERS lc_Range, lc_Boxed, lc_HorizAlign, lc_FontName, lc_Bold, ln_FontSize, lc_CellValue LOCAL ln_HorizLign, lc_FontBold lc_Bold = LOWER( lc_Bold ) lc_HorizAlign = LOWER( lc_HorizAlign ) IF EMPTY( lc_FontName ) lc_FontName = "Arial" ENDIF IF EMPTY( lc_Boxed ) lc_Boxed = "nobox" ENDIF DO CASE CASE lc_Bold = "Bold" lc_FontBold = "TRUE" OTHERWISE lc_FontBold = "FALSE" ENDCASE DO CASE CASE lc_HorizAlign = "center" ln_HorizLign = xlHAlignCenter CASE lc_HorizAlign = "right" ln_HorizLign = xlHAlignRight CASE lc_HorizAlign = "left" ln_HorizLign = xlHAlignLeft ENDCASE WITH goExcel WITH .Range( lc_Range ) .Merge .Font.Name = lc_FontName .Font.Bold = lc_FontBold .Font.Size = ln_FontSize .HorizontalAlignment = ln_HorizLign IF LEFT( LOWER( lc_Boxed ), 3 ) = "box" .Interior.Color = RGB( 210, 210, 210 ) .Borders.LineStyle = xlContinuous .Borders.Weight = xlMedium .Borders.ColorIndex = xlColorIndexBlack ENDIF .Formula = lc_CellValue ENDWITH ENDWITH RETURN( .T. )