>The second parameter is unclear. I was thinking about passing n as number of the cell to start applying additional formatting and then color. However, colors in Excel seem to be represented by some numbers.
>
>Here is what I get in my macro:
>
>Range("N4:W4").Select
>
> Application.CutCopyMode = False
>
> With Selection.Font
>
> .Name = "Tahoma"
>
> .FontStyle = "Bold"
>
> .Size = 11
>
> .Strikethrough = False
>
> .Superscript = False
>
> .Subscript = False
>
> .OutlineFont = False
>
> .Shadow = False
>
> .Underline = xlUnderlineStyleNone
>
> .ColorIndex = 5
>
> End With
>
> With Selection.Interior
>
> .ColorIndex = 33
>
> .Pattern = xlSolid
>
> .PatternColorIndex = xlAutomatic
>
> End With
>>
>And here is the function's code:
>
>************************************************************
>* FUNCTION DBFToExcel()
>************************************************************
>* Author............: VCS Developers Team (Nadya Nosonovsky)
>* Project...........: Visual Collections System
>* Created...........: 03/03/2006 10:05:42
>* Copyright.........: (c) Jzanus, 2006
>*) Description.......: Creates an Excel file from open table / cursor
>* Calling Samples...: DbfToExcel(m.lcXLSFile, @laHeader_Info, "Batch Statistics")
>* Parameter List....: tcXLSFileName, taHeader_Info, tcTitle, tcPassword
>* Major change list.:
>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
>
>local loExcel, lnI, loSheet, lnK, lcError, lnLines
>lcError = ""
>
>local array laTitle[1]
>lnLines = alines(laTitle, m.tcTitle)
>
>#include Excel.h
>#define xlPart 2
>
>*-- Add Header into XLS File
>try
> 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
> .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 alen(taHeader_Info,1)
> 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])
> loRange = loSheet.UsedRange.Offset(m.lnLines + 2,0)
> loRange.columns[m.lnK].NumberFormat = taHeader_Info[m.lnK,3]
> endif
>
> if !empty(taHeader_Info[m.lnK,4])
> loSheet.columns[m.lnK].select
> loSheet.columns[m.lnK].columnwidth = taHeader_Info[m.lnK,4]
> endif
> next
> next
>
>** 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
> endif
> loExcel.save()
>
>catch to loError
> lcError = Log_Error(m.loError)
>finally
> if vartype(m.loExcel) = 'O'
> loExcel.DisplayAlerts = .t.
> loExcel.quit
> endif
>endtry
>
>if not empty(m.lcError)
> =ErrorMsg(m.lcError)
>endif
>
>return m.lcError
>endfunc
>>
>BTW, I was just thinking, I do not need to restore DisplayAlerts back, do I?
You could use Font.Color instead of ColorIndex
Range("N4:W4").Select
Application.CutCopyMode = False
With Selection.Font
.Name = "Tahoma"
.FontStyle = "Bold"
.Size = 11
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.Color = RGB(255,0,0)
End With
With Selection.Interior
.ColorIndex = RGB(192,192,192)
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End WithHere how I would change the function:
function DBFToExcel
lparameters tcXLSFileName, taHeader_Info, tcTitle, tcPassword, lbNeedAdditionalFormating, laAditionalFields
external array taHeader_Info
local loExcel, lnI, loSheet, lnK, lcError, lnLines
lcError = ""
local array laTitle[1]
lnLines = alines(laTitle, m.tcTitle)
#include Excel.h
#define xlPart 2
try
copy to (m.tcXLSFileName) type xl5
loExcel=createobject("Excel.Application")
loExcel.application.WorkBooks.open(m.tcXLSFileName)
loExcel.DisplayAlerts = .f.
for lnI = 1 to loExcel.application.application.WorkBooks(1).Sheets.count
loSheet = loExcel.application.application.WorkBooks(1).Sheets(m.lnI)
loSheet.rows("1").delete(xlShiftDown)
loSheet.rows("1:"+ alltrim(str(m.lnLines + 2))).insert(xlShiftDown)
with loSheet.range("1:" + alltrim(str(m.lnLines))).font
.color = 8388736
.size = 14
.Bold = .t.
.name = 'Tahoma'
endwith
with loSheet.range(alltrim(str(m.lnLines + 1)) + ;
":" + alltrim(str(m.lnLines + 2))).font
.size = 11
.Bold = .t.
.name = 'Tahoma'
endwith
for lnK = 1 to m.lnLines
loSheet.Cells(m.lnK, 1).value = laTitle[m.lnK]
next
for lnK = 1 to alen(taHeader_Info,1)
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])
if !empty(taHeader_Info[m.lnK,3])
loRange = loSheet.UsedRange.Offset(m.lnLines + 2,0)
loRange.columns[m.lnK].NumberFormat = taHeader_Info[m.lnK,3]
endif
if !empty(taHeader_Info[m.lnK,4])
loSheet.columns[m.lnK].select
loSheet.columns[m.lnK].columnwidth = taHeader_Info[m.lnK,4]
endif
next
next
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
endif
IF m.lbNeedAdditionalFormating
ENDIF
loExcel.save()
catch to loError
lcError = Log_Error(m.loError)
finally
if vartype(m.loExcel) = 'O'
loExcel.DisplayAlerts = .t.
loExcel.quit
endif
endtry
if not empty(m.lcError)
=ErrorMsg(m.lcError)
endif
return m.lcError
endfunc
Against Stupidity the Gods themselves Contend in Vain - Johann Christoph Friedrich von Schiller
The only thing normal about database guys is their tables.
