Excelde hücre rengi değiştirme

*** Author: Cetin Basoz

 

lcXLS = Sys(5)+Curdir()+'Conditional.xls'

Rand(-1)

Select cust_id, Company, Iif(Int(Rand()*100)%2=0,0.05,Round(Rand(),2)) As myValue ;

  from customer ;

  into Cursor crsCustomer

Copy To (lcXLS) Type Xl5

 

 

#Define xlCellValue    1

#Define xlExpression    2

 

#Define xlBetween    1

#Define xlNotBetween    2

#Define xlEqual    3

#Define xlNotEqual    4

#Define xlGreater    5

#Define xlLess    6

#Define xlGreaterEqual    7

#Define xlLessEqual    8

 

lnRows = Reccount()

lnCols = Fcount()

 

Use In 'crsCustomer'

Use In 'customer'

 

oExcel = Createobject('Excel.Application')

With oExcel

  .WorkBooks.Open(lcXLS)

  ValueSample()

  .Visible = .T.

Endwith

 

Function ValueSample

lcRange = _GetChar(lnCols)+'2:'+;

  _GetChar(lnCols)+Ltrim(Str(lnRows+1)) && 1 header

With oExcel.ActiveWorkBook.ActiveSheet.Range(lcRange)

  .FormatConditions.Delete

 

  .FormatConditions.Add(xlCellValue, xlEqual, ".05" )

  .FormatConditions.Add(xlCellValue, xlLess, ".50" )

  .FormatConditions.Add(xlCellValue, xlGreaterEqual, ".8" )

  With .FormatConditions(1)

    .Font.ColorIndex = 1

    .Interior.ColorIndex = 4

    .Font.Bold = 1

  Endwith

  With .FormatConditions(2)

    .Font.ColorIndex = 1

    .Interior.ColorIndex = 44

    .Font.Bold = 1

  Endwith

  With .FormatConditions(3)

    .Font.ColorIndex = 1

    .Interior.ColorIndex = 3

    .Font.Bold = 1

  Endwith

 

Endwith

 

* Return A, AA, BC etc noation for nth column

Function _GetChar

Lparameters tnColumn && Convert tnvalue to Excel alpha notation

If tnColumn = 0

  Return ""

Endif

If tnColumn <= 26

  Return Chr(Asc("A")-1+tnColumn)

Else

  Return     _GetChar(Int(Iif(tnColumn % 26 = 0,tnColumn - 1, tnColumn) / 26)) + ;

    _GetChar((tnColumn-1)%26+1)

Endif