diadem how to color cells individually

[gizmogal]

Hi Louval,

Did you finally get this to work? I have a working application (see image) where I color the background of each cell based on the value it contains, and I had many of the same issues you are describing. I'd be happy to walk you through it if you are still not happy with your results.

[louval]

Hi!

Thank you for your concern. No without fighting hard agaist the machine. It seems I have won.

Cheers,

Louval

[gizmogal]

Looks great! Success feels good, doesn't it?

[Greg_Gran]

Congrats!

I've got a whole folder allocated to various user commands for table formatting. Here is a common one that I use for marginal and hard failure criterea. 

I still wish you could use property values directly, instead of having to copy them into data channels...

[Louval2]

Hi,

Could you please give me an example of use of this great function of yours?

Best regards,

Louval

[llx]

Hi, Louval

This looks great. What method do you use to highlight the cell?

Thank you.

[llx]

Hi, gizmogal,

I like the example you posted and I am trying to color my table cell like this way. I really appreciate your help if you can walk me through this.

By the way, the table cell I have contains text value, such as pass/fail, I want to color fail to red etc. Thanks,

LLX

[JoshRew]

All,

In my experience, DIAdem 2012+ allows foreground coloring, 2014+ allows background coloring.

As to how to do the coloring, I use the newer Object Oriented methods:

Link the UserCommand subroutine to the column in question:

  Report.Sheets(1).Objects("Table").Columns(1).Settings.OnDrawingCell = UserCommandSubroutineName

Set up your usercommand subroutine to use the cell's value to set the color of the cell based on the value:

Sub UserCommandSubroutineName(Context, Cell)
  Set oCurrColumn = Context.Table.Columns.Item(Context.Col)
  set oSettings = oCurrColumn.Settings
  Set oCurrChannel = Data.GetChannels(oCurrColumn.Channel.Reference)
  if oCurrChannel.Count > 0 then
    CurrText = ucase(Cell.Value)
    Select Case CurrText
    Case "PASS", "OK", "ACCEPTABLE"  'Green
      '"FG"
      'oSettings.Font.Color.ColorIndex=eColorIndexDarkGreen
      '"BG"
      oSettings.BackgroundColor.ColorIndex=eColorIndexOtherColors
      Call oSettings.BackgroundColor.SetFillingColor(RGB(50, 150, 50), RGB(50, 200, 100), eColorGradientVertical, eColorGradientModeFromOutside)
    Case "FAIL", "BAD", "HIGH", "ELEVATED"  'Red
      '"FG"
      'oSettings.Font.Color.ColorIndex=eColorIndexRed
      '"BG"
      oSettings.BackgroundColor.ColorIndex=eColorIndexOtherColors
      Call oSettings.BackgroundColor.SetFillingColor(RGB(255, 50, 50), RGB(255, 100, 100), eColorGradientVertical, eColorGradientModeFromOutside)
    End Select
  end if
end Sub 'UserCommandSubroutineName

You can set up generic subroutines to handle sets of text values, numeric values based on min/max or seperate min/max channels.  I would recommend using a property on the channel do determine which type of coloring and comparison you intent the subroutine to do (so you don't need hundreds of routines).

This code may not work directly because I've cut it out of much more generic scripts and pieced it together here, but the basic principles should apply.

-Josh

[DLClark]

To gizmogal:

Your table design is just what I'm trying to achieve without much luck. It's been a while but can you post the code that performs your cell coloring? You'd think by version 2017 they would have solved this with a simple property but not so as yet. Anyway please send a code fragment if you can.

[llx]

Hi, here is my code for coloring table cells -- pass (green), fail (red) . I used DIadem 2014. This is the function to generate overalltable and call cell coloring function. in this function 't' is the result count, fox example I have 240 results to be listed in table, each table page has 30 rows, then totally 8 pages table will be auto generated.

function CreateFailTables(ReportFilePath,t)

Dim i, iMax

iMax = (t+5)/NumTableRows

iMAx = int(iMax)+1

Call WndShow("REPORT")

FOR i = 1 TO iMax

Call PicFileAppend(ReportFilePath)

Call GraphSheetInfos()

Call GraphSheetNGet(GraphSheetCount)

Call GraphSheetRefSet(GraphSheetName)

Call GraphSheetRename(GraphSheetName, "Pass Fail " & i)

Call GraphObjOpen("2DTable1")

D2TabAutoScalTyp = "fixed"

D2TabBegin = 1 + (i-1)*NumTableRows

D2TabEnd = i*NumTableRows

D2TabNoDist = 1

Call GraphObjClose("2DTable1")

Report.Sheets("Pass Fail " & i).Objects("2DTable1").Columns(1).Settings.OnDrawingCell = "TabPassFailOnDrawingCell"

Report.Sheets("Pass Fail " & i).Objects("2DTable1").Columns(10).Settings.OnDrawingCell = "TabPassFailOnDrawingCell"

Call PicUpdate

NEXT ' i

End function ' CreateFailTables()

''this is cell coloring function, based on cell value to color.

Sub TabPassFailOnDrawingCell(Content, Cell)

Dim CurrVal, oSettings

Set oSettings = Content.Table.Columns(1).Settings

Set oSettings1 = Content.Table.Columns(10).Settings

Set oSettings2 = Content.Table.Columns(2).Settings

　

CurrVal = Cell.Value

If Trim(UCase(CurrVal)) = "PASS" Then

oSettings.BackgroundColor.ColorIndex = eColorIndexGreen

oSettings1.BackgroundColor.ColorIndex = eColorIndexGreen

oSettings2.BackgroundColor.ColorIndex = eColorIndexGreen

ELSEif Trim(UCase(CurrVal)) = "FAIL" Then

oSettings.BackgroundColor.ColorIndex = eColorIndexRed

oSettings1.BackgroundColor.ColorIndex = eColorIndexRed

oSettings2.BackgroundColor.ColorIndex = eColorIndexRed

ELSEif Trim(UCase(CurrVal)) = "" Then

oSettings.BackgroundColor.ColorIndex = eColorIndexNone

oSettings1.BackgroundColor.ColorIndex = eColorIndexNone

oSettings2.BackgroundColor.ColorIndex = eColorIndexNone

ELSEif Trim(UCase(CurrVal)) = "NULL" then

oSettings.BackgroundColor.ColorIndex = eColorIndexYellow

oSettings1.BackgroundColor.ColorIndex = eColorIndexYellow

oSettings2.BackgroundColor.ColorIndex = eColorIndexYellow

ELSEif Trim(UCase(CurrVal)) = "Incomplete" then

oSettings.BackgroundColor.ColorIndex = eColorIndexYellow

oSettings1.BackgroundColor.ColorIndex = eColorIndexYellow

oSettings2.BackgroundColor.ColorIndex = eColorIndexYellow

End If

End Sub ' TabPassFailOnDrawingCell()