function DBFToExcel lparameters tcXLSFileName, taHeader_Info, tcTitle, tcPassword external array taHeader_Info * This function assumes, that the output table (cursor) is currently opened *-- Generate output to XLS File * -- Do some basic parameter checking if empty(alias()) return "No table/cursor is currently opened to process." endif if empty(m.tcXLSFileName) return "Excel file name is not passed." endif if type("taHeader_Info[1]") <> "C" return "Array taHeader_Info is not passed." endif if vartype(m.tcTitle) <> "C" return "Excel title is not passed." endif local loExcel, lnI, loSheet, lnK, lcError, lnLines, ; lnActualFields, lnHeaderCells, lcRange, lcStart, lcEnd, lnCols lcError = "" local array laTitle[1] lnLines = alines(laTitle, m.tcTitle) #include Excel.h #define xlPart 2 try lnActualFields = fcount() lnHeaderCells = alen(taHeader_Info,1) copy to (m.tcXLSFileName) type xl5 *-- Create Ole Automation with Excel loExcel = createobject("Excel.Application") *-- Open XLS File loExcel.application.WorkBooks.open(m.tcXLSFileName) loExcel.DisplayAlerts = .f. for lnI = 1 to loExcel.application.application.WorkBooks(1).Sheets.count *-- Select individual sheets from open XLS File loSheet = loExcel.application.application.WorkBooks(1).Sheets(m.lnI) ** Delete the column headers from Excel (first row) loSheet.rows("1").delete(xlShiftDown) ** Insert lines with Title + 2 empty rows for the column headers loSheet.rows("1:"+ alltrim(str(m.lnLines + 2))).insert(xlShiftDown) with loSheet.range("1:" + alltrim(str(m.lnLines))).font .color = 8388736 && rgb(255,0,0) .size = 14 .Bold = .t. .name = 'Tahoma' endwith with loSheet.range(alltrim(str(m.lnLines + 1)) + ; ":" + alltrim(str(m.lnLines + 2))).font * .Color = Rgb(255,0,0) .size = 11 .Bold = .t. .name = 'Tahoma' endwith *!* With loSheet.Range("1:2").Borders *!* .Weight = xlMedium *!* .LineStyle = xlContinuous *!* Endwith for lnK = 1 to m.lnLines loSheet.Cells(m.lnK, 1).value = laTitle[m.lnK] next for lnK = 1 to m.lnHeaderCells loSheet.Cells(2 + m.lnLines, m.lnK).value = taHeader_Info[m.lnK,1] + ; iif(empty(taHeader_Info[m.lnK,2]), "", ; chr(10) + taHeader_Info[m.lnK,2]) * loSheet.Cells(3 + m.lnLines,m.lnK).value = taHeader_Info[m.lnK,2] if !empty(taHeader_Info[m.lnK,3]) && There is format information loRange = loSheet.UsedRange.Offset(m.lnLines + 2,0) && we don't want to apply format for header rows loRange.columns[m.lnK].NumberFormat = taHeader_Info[m.lnK,3] endif if !empty(taHeader_Info[m.lnK,4]) && There is Column Width loSheet.columns[m.lnK].select loSheet.columns[m.lnK].columnwidth = taHeader_Info[m.lnK,4] endif next next if m.lnHeaderCells > m.lnActualFields lnCols = m.lnActualFields + 1 ** Code from Sergey Berezniker lcStart = iif(m.lnCols>26, chr(int((m.lnCols - 1) / 26) + 64), "") + ; chr(((m.lnCols - 1) % 26) + 65) lnCols = m.lnHeaderCells lcEnd = iif(m.lnCols>26, chr(int((m.lnCols - 1) / 26) + 64), "") + ; chr(((m.lnCols - 1) % 26) + 65) lcRange = m.lcStart + alltrim(str(m.lnLines + 2)) + ":" + ; m.lcEnd + alltrim(str(m.lnLines + 2)) * loSheet.range(m.lcRange).select with loSheet.range(m.lcRange).Interior .ColorIndex = 33 && Blue Color .pattern = xlSolid .PatternColorIndex = xlAutomatic endwith endif ** Made the Totals row in bold and Green highlight loExcel.range([A1], loExcel.selection.SpecialCells(xlLastCell)).select loExcel.selection.FormatConditions.delete loExcel.selection.FormatConditions.add(xlExpression,, '=UPPER(Left($A1,5))="TOTAL"') with loExcel.selection.FormatConditions(1) .font.Bold = .t. .Interior.ColorIndex = 4 endwith if not empty(m.tcPassword) loExcel.ActiveWorkbook.password = m.tcPassword && Works in Excel 2003 endif loExcel.save() catch to loError lcError = Log_Error(m.loError) finally if vartype(m.loExcel) = 'O' loExcel.DisplayAlerts = .t. && Restore back loExcel.quit endif endtry if not empty(m.lcError) =ErrorMsg(m.lcError) endif return m.lcError endfunc