Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
Writing to an excel file
Message
From
11/05/2011 18:31:43
 
 
To
10/05/2011 12:53:44
General information
Forum:
Visual FoxPro
Category:
Client/server
Environment versions
Visual FoxPro:
VFP 9 SP2
OS:
Windows 7
Database:
Visual FoxPro
Miscellaneous
Thread ID:
01510189
Message ID:
01510406
Views:
70
Yossi:

I just finished some Excel automation this yesterday and am copying four of the methods attached that do the Excel instantiation, copying one of the files, etc. Somewhere in this you may find something useful. My experience with Office automation using VFP is you need a good network connection to speed up all the Google searches for answers. They're there, you just have to be persistent. A couple of helpful hints:

(1) In Excel 2010 go to File / Options/ Customize ribbon and make sure "Developer" is enabled.
(2) In Excel go to the "Developer" tab, click on "Record Macro" and manually do what you want to automate.
(3) When finished click on "Stop Recording" then click "Visual Basic"
(4) A Microsoft VB for Applications window will open. Look under the "Modules" folder, poke around, you will find very useful code for the operation you were attempting. It may not work exactly as shown but you'll be pointed in the right direction.
(5) When debugging be sure to set the Excel property "Visible" to .T. so you can watch the sheet being built.

Good luck on what can be a pain in the a$$ task. There are other ways to export data to Excel but using automation is the only way I know to present the user with something that even approaches a finished task. Sorry if some of the code's a bit sloppy, toward the end I just wanted to finish leaving cleanup for the next time I look at the program - which will be too soon.

Scott
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. )
Scott Ramey
BDS Software
Previous
Next
Reply
Map
View

Click here to load this message in the networking platform