[Solved] Color Macro from MS Excel into Calc

Creating a macro - Writing a Script - Using the API

[Solved] Color Macro from MS Excel into Calc

Postby f_o_555 » Mon Jun 27, 2011 10:27 pm

Hi all,
I've been using the code posted on http://www.cpearson.com/excel/colors.aspx (http://www.cpearson.com/Zips/modColorFunctions.zip) to handle the color of cells under MS-Excel.
Now I switched to MAC and I'm using Calc.
I would like to keep using the macro that allows handling the color of cells; I tried to convert the code using the website http://www.business-spreadsheets.com/vba2oo.asp

When looking the macro in tools/macros/organize marcos/open office basic, the functions appear in the list but I get the error message BASIC error expected: sub

I'm not able to attach the text that I'm using, it keeps rejecting any file extension that I'm using. The code is copied pasted below, if someone wants to have a look.
It is probably something very easy to solve but I'm not an expert at all, I spent already few days looking on the web but without success.
Thank you for your help,
Sarah


Code: Select all   Expand viewCollapse view
Attribute VB_Name = "modColorFunctions"
Option Explicit
Option Compare Text
Option Base 1
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' modColorFunctions
' By Chip Pearson, chip@cpearson.com
'       www.cpearson.com
'       This module described at www.cpearson.com/Excel/Colors.aspx
' Date: 24-January-2008.
'
' This module contains procedures for working with colors in
' Excel. The following functions are provided:
'       ChooseColorDialog
'           This display a standard Windows color picker
'           dialog and returns the selected RGB Long.
'       RGBLong
'           This returns the RGB Long Integer from a Red,
'           Blue, and Green color values.
'       ColorIndexOfRGBLong
'           This returns the ColorIndex associated with an
'           RGB color value.
'       RGBLongFromColorIndex
'           This returns the RGB value corresponding to
'           a ColorIndex.
'       ColorIndexOfDim oSheet as Object
oSheet = ThisComponent.CurrentController.ActiveSheet
oSheet.getCellRangeByName($1)
'           This returns an array of ColorIndex values
'           of a Dim oSheet as Object
oSheet = ThisComponent.CurrentController.ActiveSheet
oSheet.getCellRangeByName($1) of cells. The ColorIndex of either
'           the Font property or the Interior property may
'           be used.
'       ColorIndexOfOneCell
'           This returns the ColorIndex of a single cell.
'           The ColorIndex of either the Font property or
'           the Interior property may be used.
'       IsValidColorIndex
'           This indicates whether a value is a valid ColorIndex.
'       RGBComponentsFromRGBLong
'           This returns a 1-base 3-element array contain the
'           component Red, Green, and Blue values of an RGB color.
'       RGBComponentsFromRGBLongToVariables
'           This sets ByRef Long variables to the component
'           Red, Green, and Blue values of an RGB color.
'       IsValidRGBLong
'           This indicates if a Long Integer is a valid RGB color.
'       CountColors
'           This counts the number of cells in a Dim oSheet as Object
oSheet = ThisComponent.CurrentController.ActiveSheet
oSheet.getCellRangeByName($1) that have
'           a specified color index.
'           The ColorIndex of either the Font property or
'           the Interior property may be used.
'       SumColors
'           This sums the cells that have a specified color
'           index value. You can specify different Dim oSheet as Object
oSheet = ThisComponent.CurrentController.ActiveSheet
oSheet.getCellRangeByName($1)s
'           for the color test ThisComponent.CurrentController.ThisComponent.CurrentController.ActiveSheet.getCellDim oSheet as Object
oSheet = ThisComponent.CurrentController.ActiveSheet
oSheet.getCellRangeByName($1)ByName( and the).Values to sum
'           ThisComponent.CurrentController.ThisComponent.CurrentController.ActiveSheet.getCellDim oSheet as Object
oSheet = ThisComponent.CurrentController.ActiveSheet
oSheet.getCellRangeByName($1)ByName( (e.g., sum).Values in C where colum A is red).
'           The ColorIndex of either the Font property or
'           the Interior property may be used.
'       DefaultColorPallet
'           This returns an array of the DEFAULT color values.
'           The array is either a 1-based array of 56 RGB colors
'           or a 0-based array of 57 elements where
'           element 0 = -1 And elements 1 to 56 are RGB colors,'
'           depending on the Option Base of the module that
'           contains the function. Regardless of Option Base,
'           a ColorIndex may be used as an index into the array.
'       DefaultColorNames
'           This returns an array of the DEFAULT US-English
'           color names. These are the same names that appear
'           as control tips in the color drop down for the
'           fill color and text color command buttons. ColorIndex
'           values 1 to 16 and 26 to 56 have names. ColorIndex
'           values from 17 to 25 do not have names. The array
'           is properly based so that a ColorIndex value may
'           be used as the index into the array.
'       IsColorIndexDefault
'           This returns TRUE if color corresponding to the
'           specified ColorIndex is the default Excel color
'           or FALSE if the color corresponding to the specified
'           ColorIndex is not the system default.
'       IsColorPalletDefault
'           This returns TRUE if the color pallet for the specified
'           workbook is unchanged, or FALSE if the color pallet
'           has been changed.
'       ColorName
'           This returns the US-English name of a specified RGB
'           color. The specified RGB color must be present in
'           the Excel Default Pallet, but it is not required
'           that the RGB color reside the same location in the
'           Excel Default Pallet as the location in the current
'           in-use pallet. If no matching RGB color is found,
'           the result is vbNullString. If the color resides
'           in the Excel Default Pallet in locations 17 through
'           25 (inclusive), the result is "UNNAMED". There
'           is no way to get a color name if the RGB color
'           is not a member of the Excel Default Pallet.
'       Dim oSheet as Object
oSheet = ThisComponent.CurrentController.ActiveSheet
oSheet.getCellRangeByName($1)OfColors
'           This returns a Dim oSheet as Object
oSheet = ThisComponent.CurrentController.ActiveSheet
oSheet.getCellRangeByName($1) object containing the individual
'           cells whose Font or Interior have the specified
'           color index.
'
'
' In all functions, ColorIndex is a value between 1 and 56
' (inclusive) or xlColorIndexNone or xlColorIndexAutomatic.
' RGBLong is a Long Integer between &H00000000 and &H00FFFFFF.
' An RGB color is stored in a 8-byte Long Integer, having bytes
' equal to, left to right:
'   ||00|BB|GG|RR||
'   where BB are the Blue bytes, GG are the Green bytes, and
'   RR are the Red bytes.

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Const C_RGB_RED As Long = &HFF&
Public Const C_RGB_GREEN As Long = &HFF00&
Public Const C_RGB_BLUE As Long = &HFF0000
Public Const C_RGB_WHITE As Long = &HFFFFFF
Public Const C_RGB_BLACK As Long = &H0&
Public Const C_MIN_COLOR_INDEX = 1
Public Const C_MAX_COLOR_INDEX = 56
Public Const C_MIN_RGB = C_RGB_BLACK
Public Const C_MAX_RGB = C_RGB_WHITE
Public Const C_SHIFT_ONE_BYTE = &H100&
Public Const C_SHIFT_TWO_BYTES = &H10000


Private Declare Function GetActiveWindow Lib "user32.dll" () As Long
Private Declare Function ChooseColorDlg Lib "comdlg32.dll" Alias "ChooseColorA" ( _
    pChoosecolor As CHOOSECOLOR) As Long


Private Const CC_RGBINIT = &H1&
Private Const CC_FULLOPEN = &H2&
Private Const CC_PREVENTFULLOPEN = &H4&
Rem oDlg should be visible at the module level
Dim oDlg As Object
DialogLibraries.LoadLibrary("Standard")
oDlg = CreateUnoDialog(DialogLibraries.Standard.$1)
oDlg.execute()HELP = &H8&
Private Const CC_ENABLEHOOK = &H10&
Private Const CC_ENABLETEMPLATE = &H20&
Private Const CC_ENABLETEMPLATEHANDLE = &H40&
Private Const CC_SOLIDCOLOR = &H80&
Private Const CC_ANYCOLOR = &H100&


Private Type CHOOSECOLOR
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    rgbResult As Long
    lpCustColors As Long
    flags As Long
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
End Type


Private dwCustClrs(0 To 15) As Long
Private Init As Boolean

Public Function ChooseColorDialog(DefaultColor As Long) As Long
    Dim lpChoosecolor As CHOOSECOLOR
    With lpChoosecolor
        .lStructSize = Len(lpChoosecolor)
        .hwndOwner = GetActiveWindow
        .rgbResult = DefaultColor
        .lpCustColors = VarPtr(dwCustClrs(0))
        .flags = CC_ANYCOLOR Or CC_RGBINIT Or CC_FULLOPEN
    End With
    If ChooseColorDlg(lpChoosecolor) Then
        ChooseColorDialog = lpChoosecolor.rgbResult
    Else
        ChooseColorDialog = -1
    End If
End Function


Function RGBLong(Red As Long, Green As Long, Blue As Long) As Long
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' RGBLong
' This function returns a Long integer representing the color
' defined by the Red, Green, and Blue values. It returns -1
' if any parameter is not in the Dim oSheet as Object
oSheet = ThisComponent.CurrentController.ActiveSheet
oSheet.getCellRangeByName($1) 0 <= V <= 255.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    If (Red < 0) Or (Red > 255) Then
        RGBLong = -1
        Exit Function
    End If
    If (Green < 0) Or (Green > 255) Then
        RGBLong = -1
        Exit Function
    End If
    If (Blue < 0) Or (Blue > 255) Then
        RGBLong = -1
        Exit Function
    End If
    RGBLong = RGB(Red, Green, Blue)
End Function

Function ColorIndexOfRGBLong(RGBLong As Long) As Long
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' ColorIndexOfRGBLong
' This returns the ColorIndex into the color pallet of the
' color represented by RGBLong. It returns -1 if the RGBLong
' is not found in the pallet or if RGBLong is < C_RGB_BLACK or
' greater than C_RGB_WHITE.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim V As Variant
If (RGBLong < C_RGB_BLACK) Or (RGBLong > C_RGB_WHITE) Then
    ColorIndexOfRGBLong = 0
    Exit Function
End If

V = Application.Match(RGBLong, ThisWorkbook.Colors, 0)
If IsError(V) = True Then
    ColorIndexOfRGBLong = 0
Else
    ColorIndexOfRGBLong = CLng(V)
End If

End Function

Function RGBLongFromColorIndex(ColorIndex As Long) As Long
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' RGBLongFromColorIndex
' This returns the RGB Color corresponding to the specified
' ColorIndex. It returns -1 if ColorIndex is not between 1
' and 56.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If (ColorIndex <= 0) Or (ColorIndex >= 57) Then
    RGBLongFromColorIndex = -1
Else
    RGBLongFromColorIndex = ThisWorkbook.Colors(ColorIndex)
End If
End Function

Function ColorIndexOfDim oSheet as Object
oSheet = ThisComponent.CurrentController.ActiveSheet
oSheet.getCellRangeByName($1)(InDim oSheet as Object
oSheet = ThisComponent.CurrentController.ActiveSheet
oSheet.getCellRangeByName($1) As Dim oSheet as Object
oSheet = ThisComponent.CurrentController.ActiveSheet
oSheet.getCellRangeByName($1), _
    Optional OfText As Boolean = False, _
    Optional DefaultColorIndex As Long = -1) As Variant
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' ColorIndexFromDim oSheet as Object
oSheet = ThisComponent.CurrentController.ActiveSheet
oSheet.getCellRangeByName($1)
' This function returns an array of values, each of which is
' the ColorIndex of a cell in InDim oSheet as Object
oSheet = ThisComponent.CurrentController.ActiveSheet
oSheet.getCellRangeByName($1). If InDim oSheet as Object
oSheet = ThisComponent.CurrentController.ActiveSheet
oSheet.getCellRangeByName($1) contains both
' multiple rows and multiple columns, the array is two dimensional,
' number of rows x number of columns. If InDim oSheet as Object
oSheet = ThisComponent.CurrentController.ActiveSheet
oSheet.getCellRangeByName($1) is either a single
' row or a single column, the array is single dimensional. If
' InDim oSheet as Object
oSheet = ThisComponent.CurrentController.ActiveSheet
oSheet.getCellRangeByName($1) has multiple rows, the array is transposed before
' returning it. The DefaultColorIndex indicates what color
' index to value to substitute for xlColorIndexNone and
' xlColorIndexAutomatic. If OfText is True, the ColorIndex
' of the cell's Font property is returned. If OfText is False
' or omitted, the ColorIndex of the cell's Interior property
' is returned.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Dim Arr() As Long
Dim NumRows As Long
Dim NumCols As Long
Dim RowNdx As Long
Dim ColNdx As Long
Dim CI As Long
Dim Trans As Boolean

Application.Volatile True
If InDim oSheet as Object
oSheet = ThisComponent.CurrentController.ActiveSheet
oSheet.getCellRangeByName($1) Is Nothing Then
    ColorIndexOfDim oSheet as Object
oSheet = ThisComponent.CurrentController.ActiveSheet
oSheet.getCellRangeByName($1) = CVErr(xlErrRef)
    Exit Function
End If
If InDim oSheet as Object
oSheet = ThisComponent.CurrentController.ActiveSheet
oSheet.getCellRangeByName($1).Areas.Count > 1 Then
    ColorIndexOfDim oSheet as Object
oSheet = ThisComponent.CurrentController.ActiveSheet
oSheet.getCellRangeByName($1) = CVErr(xlErrRef)
    Exit Function
End If
If (DefaultColorIndex < -1) Or (DefaultColorIndex > 56) Then
    ColorIndexOfThisComponent.CurrentController.ThisComponent.CurrentController.ActiveSheet.getCellDim oSheet as Object
oSheet = ThisComponent.CurrentController.ActiveSheet
oSheet.getCellRangeByName($1)ByName( = CVErr(xlEr).Value)
    Exit Function
End If

NumRows = InDim oSheet as Object
oSheet = ThisComponent.CurrentController.ActiveSheet
oSheet.getCellRangeByName($1).Rows.Count
NumCols = InDim oSheet as Object
oSheet = ThisComponent.CurrentController.ActiveSheet
oSheet.getCellRangeByName($1).Columns.Count

If (NumRows > 1) And (NumCols > 1) Then
    ReDim Arr(1 To NumRows, 1 To NumCols)
    For RowNdx = 1 To NumRows
        For ColNdx = 1 To NumCols
            CI = ColorIndexOfOneCell(Cell:=InDim oSheet as Object
oSheet = ThisComponent.CurrentController.ActiveSheet
oSheet.getCellRangeByName($1)(RowNdx, ColNdx), _
                OfText:=OfText, DefaultColorIndex:=DefaultColorIndex)
            Arr(RowNdx, ColNdx) = CI
        Next ColNdx
    Next RowNdx
    Trans = False
ElseIf NumRows > 1 Then
    ReDim Arr(1 To NumRows)
    For RowNdx = 1 To NumRows
        CI = ColorIndexOfOneCell(Cell:=InDim oSheet as Object
oSheet = ThisComponent.CurrentController.ActiveSheet
oSheet.getCellRangeByName($1).Cells(RowNdx, 1), _
            OfText:=OfText, DefaultColorIndex:=DefaultColorIndex)
        Arr(RowNdx) = CI
    Next RowNdx
    Trans = True
Else
    ReDim Arr(1 To NumCols)
    For ColNdx = 1 To NumCols
        CI = ColorIndexOfOneCell(Cell:=InDim oSheet as Object
oSheet = ThisComponent.CurrentController.ActiveSheet
oSheet.getCellRangeByName($1).Cells(1, ColNdx), _
            OfText:=OfText, DefaultColorIndex:=DefaultColorIndex)
        Arr(ColNdx) = CI
    Next ColNdx
    Trans = False
End If

If IsObject(Application.Caller) = False Then
    Trans = False
End If

If Trans = False Then
    ColorIndexOfDim oSheet as Object
oSheet = ThisComponent.CurrentController.ActiveSheet
oSheet.getCellRangeByName($1) = Arr
Else
    ColorIndexOfDim oSheet as Object
oSheet = ThisComponent.CurrentController.ActiveSheet
oSheet.getCellRangeByName($1) = Application.Transpose(Arr)
End If

End Function

Function ColorIndexOfOneCell(Cell As ThisComponent.CurrentController.ThisComponent.CurrentController.ActiveSheet.getCellDim oSheet as Object
oSheet = ThisComponent.CurrentController.ActiveSheet
oSheet.getCellRangeByName($1)ByName(, O).String As Boolean, _
    DefaultColorIndex As Long) As Long
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' ColorIndexOfOneCell
' This returns the ColorIndex of the cell referenced by Cell.
' If Cell refers to more than one cell, only Cell(1,1) is
' tested. If OfText True, the ColorIndex of the Font property is
' returned. If OfText is False, the ColorIndex of the Interior
' property is returned. If DefaultColorIndex is >= 0, this
' value is returned if the ColorIndex is either xlColorIndexNone
' or xlColorIndexAutomatic.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim CI As Long

Application.Volatile True
If OfText = True Then
    CI = Cell(1, 1).Font.ColorIndex
Else
    CI = Cell(1, 1).Interior.ColorIndex
End If
If CI < 0 Then
    If IsValidColorIndex(ColorIndex:=DefaultColorIndex) = True Then
        CI = DefaultColorIndex
    Else
        CI = -1
    End If
End If

ColorIndexOfOneCell = CI

End Function

Private Function IsValidColorIndex(ColorIndex As Long) As Boolean
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' IsValidColorIndex
' This returns TRUE if ColorIndex is between 1 and 56 or equal
' to either xlColorIndexNone or xlColorIndexAutomatic. It
' returns FALSE otherwise.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Select Case ColorIndex
    Case 1 To 56, xlColorIndexNone, xlColorIndexAutomatic
        IsValidColorIndex = True
    Case Else
        IsValidColorIndex = False
End Select
End Function


Function RGBComponentsFromRGBLong(RGBLong As Long) As Long()
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' RGBComponentsFromRGBLong
' This accepts an RGBLong and returns a 1-based array with
' three elements, containing, left-to-right, the Red, Green,
' and Blue components of the RGB Color. If RGBLong is not
' a valid RGB color, all elements of the returned array
' are -1.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Dim Arr(1 To 3) As Long

If IsValidRGBLong(RGBLong:=RGBLong) = False Then
    Arr(1) = -1
    Arr(2) = -1
    Arr(3) = -1
    Exit Function
End If

Arr(1) = RGBLong And C_RGB_RED
Arr(2) = (RGBLong And C_RGB_GREEN) \ C_SHIFT_ONE_BYTE ' shift right 1 byte
Arr(3) = (RGBLong And C_RGB_BLUE) \ C_SHIFT_TWO_BYTES ' shift right 2 bytes

RGBComponentsFromRGBLong = Arr

End Function

Function RGBComponentsFromRGBLongToVariables(RGBLong As Long, _
    ByRef Red As Long, ByRef Green As Long, ByRef Blue As Long) As Boolean
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' RGBComponentsFromRGBLongToVariables
' This set the variables references Red, Green, and Blue to
' the component colors of the RGBLong color. It returns
' True if RGBLong is a valid color (between &H00000000 and
' &H00FFFFFF) or False if RGBLong is not a valid RGB color.
' If RGBLong is invalid, the component variables are set to -1.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim Arr As Variant
If IsValidRGBLong(RGBLong) = True Then
    Arr = RGBComponentsFromRGBLong(RGBLong)
    Red = Arr(1)
    Green = Arr(2)
    Blue = Arr(3)
    RGBComponentsFromRGBLongToVariables = True
Else
    Red = -1
    Green = -1
    Blue = -1
    RGBComponentsFromRGBLongToVariables = False
End If

End Function

Function IsValidRGBLong(RGBLong As Long) As Boolean
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' IsValidRGBLong
' This returns True if RGBLong is between &H00000000 and
' &H00FFFFFF or False otherwise.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If (RGBLong >= C_MIN_RGB) And (RGBLong <= C_MAX_RGB) Then
    IsValidRGBLong = True
Else
    IsValidRGBLong = False
End If

End Function

Function CountColor(InDim oSheet as Object
oSheet = ThisComponent.CurrentController.ActiveSheet
oSheet.getCellRangeByName($1) As Dim oSheet as Object
oSheet = ThisComponent.CurrentController.ActiveSheet
oSheet.getCellRangeByName($1), ColorIndex As Long, _
    Optional OfText As Boolean = False) As Long
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' CountColor
' This function counts the cells in InDim oSheet as Object
oSheet = ThisComponent.CurrentController.ActiveSheet
oSheet.getCellRangeByName($1) whose ColorIndex
' is equal to the ColorIndex parameter. The ColorIndex of the
' Font is tested if OfText is True, or the Interior property
' if OfText is omitted or False. If ColorIndex is not a valid
' ColorIndex (1 -> 56, xlColorIndexNone, xlColorIndexAutomatic)
' 0 is returned. If ColorIndex is 0, then xlColorIndexNone is
' used if OfText is Fasle or xlColorIndexAutomatic if OfText
' is True. This allows the caller to use a value of 0 to indicate
' no color for either the Interior or the Font.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Dim R As Dim oSheet as Object
oSheet = ThisComponent.CurrentController.ActiveSheet
oSheet.getCellRangeByName($1)
Dim N As Long
Dim CI As Long

If ColorIndex = 0 Then
    If OfText = False Then
        CI = xlColorIndexNone
    Else
        CI = xlColorIndexAutomatic
    End If
Else
    CI = ColorIndex
End If


Application.Volatile True
Select Case ColorIndex
    Case 0, xlColorIndexNone, xlColorIndexAutomatic
        ' OK
    Case Else
        If IsValidColorIndex(ColorIndex) = False Then
            CountColor = 0
            Exit Function
        End If
End Select

For Each R In InDim oSheet as Object
oSheet = ThisComponent.CurrentController.ActiveSheet
oSheet.getCellRangeByName($1).Cells
    If OfText = True Then
        If R.Font.ColorIndex = CI Then
            N = N + 1
        End If
    Else
        If R.Interior.ColorIndex = CI Then
            N = N + 1
        End If
    End If
Next R

CountColor = N

End Function

Function SumColor(TestDim oSheet as Object
oSheet = ThisComponent.CurrentController.ActiveSheet
oSheet.getCellRangeByName($1) As Dim oSheet as Object
oSheet = ThisComponent.CurrentController.ActiveSheet
oSheet.getCellRangeByName($1), SumDim oSheet as Object
oSheet = ThisComponent.CurrentController.ActiveSheet
oSheet.getCellRangeByName($1) As Dim oSheet as Object
oSheet = ThisComponent.CurrentController.ActiveSheet
oSheet.getCellRangeByName($1), _
    ColorIndex As Long, Optional OfText As Boolean = False) As Variant
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' SumColor
' This function returns the sum of the values in SumDim oSheet as Object
oSheet = ThisComponent.CurrentController.ActiveSheet
oSheet.getCellRangeByName($1) where
' the corresponding cell in TestDim oSheet as Object
oSheet = ThisComponent.CurrentController.ActiveSheet
oSheet.getCellRangeByName($1) has a ColorIndex (of the
' Font is OfText is True, or of the Interior is OfText is omitted
' or False) equal to the specified ColorIndex. TestDim oSheet as Object
oSheet = ThisComponent.CurrentController.ActiveSheet
oSheet.getCellRangeByName($1) and
' SumDim oSheet as Object
oSheet = ThisComponent.CurrentController.ActiveSheet
oSheet.getCellRangeByName($1) may refer to the same Dim oSheet as Object
oSheet = ThisComponent.CurrentController.ActiveSheet
oSheet.getCellRangeByName($1). An xlErrRef (#REF) error
' is returned if either TestDim oSheet as Object
oSheet = ThisComponent.CurrentController.ActiveSheet
oSheet.getCellRangeByName($1) or SumDim oSheet as Object
oSheet = ThisComponent.CurrentController.ActiveSheet
oSheet.getCellRangeByName($1) has more than one
' area or if TestDim oSheet as Object
oSheet = ThisComponent.CurrentController.ActiveSheet
oSheet.getCellRangeByName($1) and SumDim oSheet as Object
oSheet = ThisComponent.CurrentController.ActiveSheet
oSheet.getCellRangeByName($1) have differing number of
' either rows or columns. An xlErrValue (#VALUE) error is
' returned if ColorIndex is not a valid ColorIndex value.
' If ColorIndex is 0, xlColorIndexNone is used if OfText is
' False or xlColorIndexAutomatic if OfText is True. This allows
' the caller to specify 0 for no color applied.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim D As Double
Dim N As Long
Dim CI As Long

Application.Volatile True
If (TestDim oSheet as Object
oSheet = ThisComponent.CurrentController.ActiveSheet
oSheet.getCellRangeByName($1).Areas.Count > 1) Or _
    (SumDim oSheet as Object
oSheet = ThisComponent.CurrentController.ActiveSheet
oSheet.getCellRangeByName($1).Areas.Count > 1) Or _
    (TestDim oSheet as Object
oSheet = ThisComponent.CurrentController.ActiveSheet
oSheet.getCellRangeByName($1).Rows.Count <> SumDim oSheet as Object
oSheet = ThisComponent.CurrentController.ActiveSheet
oSheet.getCellRangeByName($1).Rows.Count) Or _
    (TestDim oSheet as Object
oSheet = ThisComponent.CurrentController.ActiveSheet
oSheet.getCellRangeByName($1).Columns.Count <> SumDim oSheet as Object
oSheet = ThisComponent.CurrentController.ActiveSheet
oSheet.getCellRangeByName($1).Columns.Count) Then
    SumColor = CVErr(xlErrRef)
    Exit Function
End If
   
If ColorIndex = 0 Then
    If OfText = False Then
        CI = xlColorIndexNone
    Else
        CI = xlColorIndexAutomatic
    End If
Else
    CI = ColorIndex
End If

Select Case CI
    Case 0, xlColorIndexAutomatic, xlColorIndexNone
        ' ok
    Case Else
        If IsValidColorIndex(ColorIndex:=ColorIndex) = False Then
            SumColor = CVErr(xlErrValue)
            Exit Function
        End If
End Select

For N = 1 To TestDim oSheet as Object
oSheet = ThisComponent.CurrentController.ActiveSheet
oSheet.getCellRangeByName($1).Cells.Count
    With TestDim oSheet as Object
oSheet = ThisComponent.CurrentController.ActiveSheet
oSheet.getCellRangeByName($1).Cells(N)
    If OfText = True Then
        If .Font.ColorIndex = CI Then
            If IsNumeric(SumThisComponent.CurrentController.ThisComponent.CurrentController.ActiveSheet.getCellDim oSheet as Object
oSheet = ThisComponent.CurrentController.ActiveSheet
oSheet.getCellRangeByName($1)ByName(.Cells(N)).Value) = True Then
                D = D + SumThisComponent.CurrentController.ThisComponent.CurrentController.ActiveSheet.getCellDim oSheet as Object
oSheet = ThisComponent.CurrentController.ActiveSheet
oSheet.getCellRangeByName($1)ByName(.Cells(N)).Value
            End If
        End If
    Else
        If .Interior.ColorIndex = CI Then
            If IsNumeric(SumThisComponent.CurrentController.ThisComponent.CurrentController.ActiveSheet.getCellDim oSheet as Object
oSheet = ThisComponent.CurrentController.ActiveSheet
oSheet.getCellRangeByName($1)ByName(.Cells(N)).Value) = True Then
                D = D + SumThisComponent.CurrentController.ThisComponent.CurrentController.ActiveSheet.getCellDim oSheet as Object
oSheet = ThisComponent.CurrentController.ActiveSheet
oSheet.getCellRangeByName($1)ByName(.Cells(N)).Value
            End If
        End If
    End If
    End With
Next N
           
SumColor = D

End Function

Function ColorName(RGBLong As Long) As String
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' ColorName
' This function returns the US-English color name corresponding
' to the RGBLong color value. If the position of the RGBColor
' in the DEFAULT pallet is between 1 and 16 or 26 and 56, the
' color name is returned. If the location is between 17 and 25
' or the color is not in the DEFAULT pallet, the result is
' vbNullString. It is NOT required that the pallet in use be
' the default pallet, only that the RGBLong is one of the colors
' in the default pallet. The location of RGBLong in the current
' pallet is irrelevant.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Dim N  As Long
Dim DefaultNdx As Long
Dim DefaultPallet As Variant
Dim ColorNames As Variant

If IsValidRGBLong(RGBLong:=RGBLong) = False Then
    ColorName = vbNullString
    Exit Function
End If

DefaultPallet = DefaultColorPallet()
DefaultNdx = 0
For N = C_MIN_COLOR_INDEX To C_MAX_COLOR_INDEX
    If RGBLong = DefaultPallet(N) Then
        DefaultNdx = N
        Exit For
    End If
Next N
If DefaultNdx = 0 Then
    ColorName = vbNullString
Else
    ColorNames = DefaultColorNames()
    ColorName = ColorNames(DefaultNdx)
End If

End Function




Function DefaultColorPallet() As Variant
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' DefaultColorPallet
' This returns an array of the DEFAULT color values for
' Excel 2003. Effects of an Option Base setting for the
' module that contains this function (NOT the module from
' which this function was called):
'   Option Base 0
'       Array is 0-based with 57 elements, element 0
'           is -1. Elements 1 to 56 are RGB colors.
'   Option Base 1
'       Array is 1-based with 56 elements, all of which are
'           RGB colors.
'   Option Base Omitted
'       Same as Option Base 0
' This allows the ColorIndex as the index into the array
' regardless of the module's Option Base setting.
''''''''''''' ''''''''''''''''''''''''''''''''''''''''''''''''''
Dim L(1) As Long
If LBound(L) = 0 Then
    DefaultColorPallet = Array(-1, _
        &H0&, &HFFFFFF, &HFF&, &HFF00&, &HFF0000, &HFFFF&, &HFF00FF, &HFFFF00, &H80&, &H8000&, _
        &H800000, &H8080&, &H800080, &H808000, &HC0C0C0, &H808080, &HFF9999, &H663399, &HCCFFFF, &HFFFFCC, _
        &H660066, &H8080FF, , &HFFCCCC, &H800000, &HFF00FF, &HFFFF&, &HFFFF00, &H800080, &H80&, _
        &H808000, &HFF0000, &HFFCC00, &HFFFFCC, &HCCFFCC, &H99FFFF, &HFFCC99, &HCC99FF, &HFF99CC, &H99CCFF, _
        &HFF6633, &HCCCC33, &HCC99&, &HCCFF&, &H99FF&, &H66FF&, &H996666, &H969696, &H663300, &H669933, _
        &H3300&, &H3333&, &H3399&, &H663399, &H993333, &H333333)
Else
    DefaultColorPallet = Array( _
        &H0&, &HFFFFFF, &HFF&, &HFF00&, &HFF0000, &HFFFF&, &HFF00FF, &HFFFF00, &H80&, &H8000&, _
        &H800000, &H8080&, &H800080, &H808000, &HC0C0C0, &H808080, &HFF9999, &H663399, &HCCFFFF, &HFFFFCC, _
        &H660066, &H8080FF, &HCC6600, &HFFCCCC, &H800000, &HFF00FF, &HFFFF&, &HFFFF00, &H800080, &H80&, _
        &H808000, &HFF0000, &HFFCC00, &HFFFFCC, &HCCFFCC, &H99FFFF, &HFFCC99, &HCC99FF, &HFF99CC, &H99CCFF, _
        &HFF6633, &HCCCC33, &HCC99&, &HCCFF&, &H99FF&, &H66FF&, &H996666, &H969696, &H663300, &H669933, _
        &H3300&, &H3333&, &H3399&, &H663399, &H993333, &H333333)
End If
End Function


Function DefaultColorNames() As Variant
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' DefaultColorNames
' This returns an array of the US-English color names associated with the
' DEFAULT color pallet. Effect of the Option Base statement of the module
' that contains this function (NOT the module from which this function is
' called):
'       Option Base 0
'           The returned array is 0-based with 57 elements, with element 0
'           equal to "UNNAMED" and elements 1 to 56 having the color name
'       Option Base 1
'           The returned array is 1-based with 56 elements, each of which
'           is a color name.
'       Option  Base Omitted
'           Same as Option Base 0
'   Regardless of the module's Option Base statement, the ColorIndex is
'   a valid index into the array.
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim L(1) As Long
If LBound(L) = 0 Then
    DefaultColorNames = Array("UNNAMED", _
    "Black", "White", "Red", "Bright Green", "Blue", "Yellow", "Pink", "Turquoise", _
    "Dark Red", "Green", "Dark Blue", "Dark Yellow", "Violet", "Teal", "Gray 25%", "Gray 50%", _
    "UNNAMED", "UNNAMED", "UNNAMED", "UNNAMED", "UNNAMED", "UNNAMED", "UNNAMED", "UNNAMED", _
    "Dark Blue", "Pink", "Yellow", "Turquoise", "Violet", "Dark Red", "Teal", "Blue", _
    "Sky Blue", "Light Turquoise", "Light Green", "Light Yellow", "Pale Blue", "Rose", "Lavender", "Tan", _
    "Light Blue", "Aqua", "Lime", "Gold", "Light ODim oSheet as Object
oSheet = ThisComponent.CurrentController.ActiveSheet
oSheet.getCellRangeByName($1)", "ODim oSheet as Object
oSheet = ThisComponent.CurrentController.ActiveSheet
oSheet.getCellRangeByName($1)", "Blue Gray", "Gray 40%", _
    "Dark Teal", "Sea Green", "Dark Green", "Olive Green", "Brown", "Plum", "Indigo", "Gray 80%")
Else
    DefaultColorNames = Array( _
    "Black", "White", "Red", "Bright Green", "Blue", "Yellow", "Pink", "Turquoise", _
    "Dark Red", "Green", "Dark Blue", "Dark Yellow", "Violet", "Teal", "Gray 25%", "Gray 50%", _
    "UNNAMED", "UNNAMED", "UNNAMED", "UNNAMED", "UNNAMED", "UNNAMED", "UNNAMED", "UNNAMED", _
    "Dark Blue", "Pink", "Yellow", "Turquoise", "Violet", "Dark Red", "Teal", "Blue", _
    "Sky Blue", "Light Turquoise", "Light Green", "Light Yellow", "Pale Blue", "Rose", "Lavender", "Tan", _
    "Light Blue", "Aqua", "Lime", "Gold", "Light ODim oSheet as Object
oSheet = ThisComponent.CurrentController.ActiveSheet
oSheet.getCellRangeByName($1)", "ODim oSheet as Object
oSheet = ThisComponent.CurrentController.ActiveSheet
oSheet.getCellRangeByName($1)", "Blue Gray", "Gray 40%", _
    "Dark Teal", "Sea Green", "Dark Green", "Olive Green", "Brown", "Plum", "Indigo", "Gray 80%")
End If

End Function

Function IsColorIndexDefault(ColorIndex As Long) As Boolean
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' IsColorIndexCustom
' This tests whether the RGB color corresponding to ColorIndex is the
' default pallet color or a custom color in the pallet. If the color corresponding
' to the ColorIndex is the same as the default color, the function returns TRUE.
' If the ColorIndex is not the default, the function return FALSE. If ColorIndex
' is not valid, the result is TRUE.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim ColorPallet As Variant
Dim DefaultRGB As Long
Dim PalletRGB As Long
ColorPallet = DefaultColorPallet()
If (ColorIndex < C_MIN_COLOR_INDEX) Or (ColorIndex > C_MAX_COLOR_INDEX) Then
    IsColorIndexDefault = False
    Exit Function
End If
DefaultRGB = ColorPallet(ColorIndex)
PalletRGB = ThisWorkbook.Colors(ColorIndex)
If DefaultRGB = PalletRGB Then
    IsColorIndexDefault = True
Else
    IsColorIndexDefault = False
End If

End Function

Function IsColorPalletDefault(Optional Workbook As Workbook = Nothing) As Boolean
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' IsColorPalletDefault
' This returns True or False indicating whether the color pallet associated
' with Workbook is the default pallet or has been modifed. The function returns
' True if all the colors in the pallet are the default colors or False if one
' or more colors have been modified from the default. The Workbook parameter
' specifies which workbook's pallet to test. If this parameter is missing, the
' ThisComponent is tested.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim WB As Workbook
Dim DefaultPallet As Variant
Dim N As Long
If Workbook Is Nothing Then
    If Application.ThisComponent Is Nothing Then
        IsColorPalletDefault = True
    Else
        Set WB = ThisComponent
    End If
Else
    Set WB = Workbook
End If
DefaultPallet = DefaultColorPallet()
For N = 1 To 56
    If WB.Colors(N) <> DefaultPallet(N) Then
        IsColorPalletDefault = False
        Exit Function
    End If
Next N

IsColorPalletDefault = True

End Function

Function Dim oSheet as Object
oSheet = ThisComponent.CurrentController.ActiveSheet
oSheet.getCellRangeByName($1)OfColor(TestDim oSheet as Object
oSheet = ThisComponent.CurrentController.ActiveSheet
oSheet.getCellRangeByName($1) As Dim oSheet as Object
oSheet = ThisComponent.CurrentController.ActiveSheet
oSheet.getCellRangeByName($1), _
    ColorIndex As Long, Optional OfText As Boolean = False) As Dim oSheet as Object
oSheet = ThisComponent.CurrentController.ActiveSheet
oSheet.getCellRangeByName($1)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Dim oSheet as Object
oSheet = ThisComponent.CurrentController.ActiveSheet
oSheet.getCellRangeByName($1)OfColors
' This function returns a Dim oSheet as Object
oSheet = ThisComponent.CurrentController.ActiveSheet
oSheet.getCellRangeByName($1) object containing the individual cells of
' TestThisComponent.CurrentController.ThisComponent.CurrentController.ActiveSheet.getCellDim oSheet as Object
oSheet = ThisComponent.CurrentController.ActiveSheet
oSheet.getCellRangeByName($1)ByName( whose Font (if O).String is True) or Interior (if OfText is False or
' omitted) has the color index specified by ColorIndex. Note that the function
' may return Nothing.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Dim R As Dim oSheet as Object
oSheet = ThisComponent.CurrentController.ActiveSheet
oSheet.getCellRangeByName($1)
Dim RR As Dim oSheet as Object
oSheet = ThisComponent.CurrentController.ActiveSheet
oSheet.getCellRangeByName($1)
Dim CI As Long

If ColorIndex = 0 Then
    If OfText = False Then
        CI = xlColorIndexNone
    Else
        CI = xlColorIndexAutomatic
    End If
Else
    CI = ColorIndex
End If

If ColorIndex <> 0 Then
    If IsValidColorIndex(ColorIndex) = False Then
        Exit Function
    End If
End If

For Each R In TestDim oSheet as Object
oSheet = ThisComponent.CurrentController.ActiveSheet
oSheet.getCellRangeByName($1).Cells
    If OfText = False Then
        If R.Interior.ColorIndex = CI Then
            If RR Is Nothing Then
                Set RR = R
            Else
                Set RR = Application.Union(RR, R)
            End If
        End If
    Else
        If RR Is Nothing Then
            Set RR = R
        Else
            Set RR = Application.Union(RR, R)
        End If
    End If
Next R
Set Dim oSheet as Object
oSheet = ThisComponent.CurrentController.ActiveSheet
oSheet.getCellRangeByName($1)OfColor = RR

End Function

Function ColorNameOfRGB(RGBLong As Long) As String
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' ColorNameOfRGB
' Returns the name of the color specified by RGBLong
' if RGBLong is in the application default pallet.
' Otherwise, returns vbNullString.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim N As Long
Dim V As Variant
If IsValidRGBLong(RGBLong) = False Then
    Exit Function
End If
V = Application.Match(RGBLong, ThisWorkbook.Colors, 0)
If IsError(V) = True Then
    Exit Function
End If

V = DefaultColorNames(V)
If V <> vbNullString Then
    ColorNameOfRGB = V
End If

End Function
Last edited by f_o_555 on Tue Jun 28, 2011 1:15 pm, edited 3 times in total.
Sarah
Open Office 3 on MacOS 10.6.7
f_o_555
 
Posts: 3
Joined: Mon Jun 27, 2011 9:57 pm

Re: Color Macro from MS Excel into Calc

Postby Villeroy » Mon Jun 27, 2011 10:58 pm

Microsoft Excel 2010 is availlable for the Mac and reportedly it can run VBA (which Excel 2007 couldn't).
Please, edit this topic's initial post and add "[Solved]" to the subject line if your problem has been solved.
Ubuntu 18.04, OpenOffice 4.x & LibreOffice 6.x
User avatar
Villeroy
Volunteer
 
Posts: 25752
Joined: Mon Oct 08, 2007 1:35 am
Location: Germany

Re: Color Macro from MS Excel into Calc

Postby jrkrideau » Mon Jun 27, 2011 11:42 pm

f_o_555 wrote:Hi all,
I've been using the code posted on http://www.cpearson.com/excel/colors.aspx (http://www.cpearson.com/Zips/modColorFunctions.zip) to handle the color of cells under MS-Excel.
Now I switched to MAC and I'm using Calc.
I would like to keep using the macro that allows handling the color of cells; I tried to convert the code using the website http://www.business-spreadsheets.com/vba2oo.asp

When looking the macro in tools/macros/organize marcos/open office basic, the functions appear in the list but I get the error message BASIC error expected: sub

I'm not able to attach the text that I'm using, it keeps rejecting any file extension that I'm using. The code is copied pasted below, if someone wants to have a look.
It is probably something very easy to solve but I'm not an expert at all, I spent already few days looking on the web but without success.
Thank you for your help,
Sarah


What does the macro do? I mean what do they colour and why"?

Things are often done quite differently in OOo and it may be that a mix of styles and conditional formatting will do what you want.

From the little I know,(hearsay only), translating from VBA to Star Basic is not a trivial undertaking. Alternative approaches might be a lot better way to go.
AOO 4.1.5; Ubuntu 18.04
jrkrideau
Volunteer
 
Posts: 3558
Joined: Sun Dec 30, 2007 10:00 pm
Location: Kingston Ontario Canada

Re: Color Macro from MS Excel into Calc

Postby rudolfo » Mon Jun 27, 2011 11:52 pm

As jrkrideau said OpenOffice Calc and MS Excel are different in many aspects. The basic spreadsheet functionality is compatible, but macros are not compatible. Although some Excel macros (if they don't have more then 10 lines of code) might run in Calc.
The website to "translate" the VBA macro has surely some statement, that it is only a translation attempt and that the converted code might work, but is not guaranteed to work and will mostly require some manual corrections.

In general, it is not worth the time to figure out if you are on the lucky side and the converted macro is working with 2 or 3 adjustments or if you have reached a dead end street.

I did not dig too deep in the above macro -- as I said, mostly a waste of time -- but based on some signal phrases I would rather say forget the macro and better search for a template with styles that provide the same functionality. Cell styles are required in Calc for conditional formatting anyway, but because Excel lacks the concept of cell styles it must compensate for the advantages of styles with macros.
OpenOffice 3.1.1 (2.4.3 until October 2009) and LibreOffice 3.3.2 on Windows 2000, AOO 3.4.1 on Windows 7
There are several macro languages in OOo, but none of them is called Visual Basic or VB(A)! Please call it OOo Basic, Star Basic or simply Basic.
rudolfo
Volunteer
 
Posts: 1488
Joined: Wed Mar 19, 2008 11:34 am
Location: Germany

Re: Color Macro from MS Excel into Calc

Postby Villeroy » Tue Jun 28, 2011 12:08 am

Well, it is all about that common design failure where information is hidden in formatting attributes and how to extract the information from those attributes then. IMHO, this should be done in Excel and Excel only.

If you want to fix your spreadsheet design, so all values are calculated from other values, conditional formatting depends on values rather than the other way round and nothing depends on stupid Basic code, then you may try my introspective cell functions to extract color codes or anything else from your cells, convert these formulas to constants, remove the formatting attributes and apply conditional formatting based on the extracted values.
Please, edit this topic's initial post and add "[Solved]" to the subject line if your problem has been solved.
Ubuntu 18.04, OpenOffice 4.x & LibreOffice 6.x
User avatar
Villeroy
Volunteer
 
Posts: 25752
Joined: Mon Oct 08, 2007 1:35 am
Location: Germany

Re: Color Macro from MS Excel into Calc

Postby f_o_555 » Tue Jun 28, 2011 8:05 am

Thank you all for the replies. Indeed it I do not have Excel 2010 and other solutions are probably out of my expertise (so probably I would waste additional time). To the bottom line, what I need is to count the cells that have a certain color; I will try to see if I find an answer in the link posted by Villeroy.
Cheers,
Sarah
Open Office 3 on MacOS 10.6.7
f_o_555
 
Posts: 3
Joined: Mon Jun 27, 2011 9:57 pm

Re: Color Macro from MS Excel into Calc

Postby Villeroy » Tue Jun 28, 2011 11:11 am

Hiding data in formatting attributes is always a mistake.
All spreadsheets are supposed to work with values and nothing but values.

See the attached file with 2 cell ranges "before" and "after".
In column C I use my CELL_BACKCOLOR function to extract the color codes out of the cells (each color isrepresented by a number).
Column D tests if it is the red color code I'm after.
Columns F,G,H I have a new table with conditional formatting based on column F having a non-zero number or not. Play with column F. This table does not depend on silly Basic code anymore and it is much easier to highlight a row simply putting a 1 in a cell.
Attachments
conditional_format.ods
Conversion of cell background colors to values and conditional formattings
(23.56 KiB) Downloaded 2409 times
Please, edit this topic's initial post and add "[Solved]" to the subject line if your problem has been solved.
Ubuntu 18.04, OpenOffice 4.x & LibreOffice 6.x
User avatar
Villeroy
Volunteer
 
Posts: 25752
Joined: Mon Oct 08, 2007 1:35 am
Location: Germany

Re: Color Macro from MS Excel into Calc

Postby f_o_555 » Tue Jun 28, 2011 1:14 pm

Thank you, this was the way I had originally tried with MS-Excel but I didn't manage to make it work.
Greetings,
Sarah
Open Office 3 on MacOS 10.6.7
f_o_555
 
Posts: 3
Joined: Mon Jun 27, 2011 9:57 pm

Re: Color Macro from MS Excel into Calc

Postby Tennisdad » Mon Sep 12, 2016 9:00 pm

Villeroy wrote:Hiding data in formatting attributes is always a mistake.
All spreadsheets are supposed to work with values and nothing but values.

See the attached file with 2 cell ranges "before" and "after".
In column C I use my CELL_BACKCOLOR function to extract the color codes out of the cells (each color isrepresented by a number).
Column D tests if it is the red color code I'm after.
Columns F,G,H I have a new table with conditional formatting based on column F having a non-zero number or not. Play with column F. This table does not depend on silly Basic code anymore and it is much easier to highlight a row simply putting a 1 in a cell.


Many apologies for butting in on a rather old thread, I am doing something similar converting an Excel Spreadsheet to Open Office. I will not bore you with the gruesome details but I downloaded Villeroy's example file hoping to incorporate his excellent ideas. I was rather under the impression that if I changed the background colour of a cell in Column A say, to red, the returned code in column C would change and if I selected the correct red :) a 1 would appear in column D. Unfortunately nothing much happens. Am I doing something wrong or am wrong in my understanding??
Thanks in anticipation
OpenOffice 4.1.2 on Windows 8.1
Tennisdad
 
Posts: 5
Joined: Mon Sep 12, 2016 7:52 pm

Re: [Solved] Color Macro from MS Excel into Calc

Postby Villeroy » Tue Sep 13, 2016 4:44 pm

It works exactly the other way round. You change a cell value and get conditional formatting and calculation results updated. Same in all spreadsheets.
Please, edit this topic's initial post and add "[Solved]" to the subject line if your problem has been solved.
Ubuntu 18.04, OpenOffice 4.x & LibreOffice 6.x
User avatar
Villeroy
Volunteer
 
Posts: 25752
Joined: Mon Oct 08, 2007 1:35 am
Location: Germany

Re: [Solved] Color Macro from MS Excel into Calc

Postby Tennisdad » Tue Sep 13, 2016 6:48 pm

Hi Viileroy
I am honoured! Thank-you very much for the response. That's a pity because "the other way round" is what I thought I wanted to achieve!! I have been running a spreadsheet in Excel (pardon the rude word) and I want to transfer to open office in prep to ditching Windows (another rude word). The spreadsheet plots my son's tennis matches and has wins in one column (H) and losses in another (L). If the win is a 'ratings win',I colour the cell Green ( ratings losses in L are coloured Red) as matches only count as ratings wins if they are against equal or higher rated players. I then use a Macro in Excel to count the colours in the columns. In Open Office I have used your method to test the colour in Col H, put a one in Col K if green and then just SUM col K. This appeared not to work as, if I changed the colour of a cell column H (or A in your workbook), it didn't change the ColorCode in Column C. But I have now noticed that if you close the workbook and then re-open it, it does update columns C and D!! Any way to make this 'dynamic' so it does update C and D without having to close/reopen the book?? Hope that makes some sense.
Kind regards and thanks again for the response.
Tennisdad
OpenOffice 4.1.2 on Windows 8.1
Tennisdad
 
Posts: 5
Joined: Mon Sep 12, 2016 7:52 pm

Re: [Solved] Color Macro from MS Excel into Calc

Postby Lupp » Tue Sep 13, 2016 9:48 pm

No use in sarcasm. (Strikeout with regard to the post below. Sorry! I have to strengthen my sense concerning my poor English.)
Actually it is a bad idea to "enter" relevant information by colouring a cell. If we use a dedicated column to contain one or another letter/number of meaning (either entered via keyboard or calculated by formulae), we get things clear and have easy access to the information for any purpose.
There is no standard function returning information about colours used in cells (either for background or for text). Relying on so called macros to retrieve an information we could easily represent by standard means is not advisable. In addition the coulor values you can get for a cell by a user function are not treated by names but by RGB triples coded in 24-bit-words. Concerning colours applied due to conditional formats I do not even know a way to get the information at all accessing a cell object... Conditional formatting is a matter of high (and still growing due to feature requests) complexity.
Thus again: Treat relevant information explicitly using dedicated cells/columns. Use this information to create colouring by conditional formatting if wanted.
Last edited by Lupp on Thu Sep 15, 2016 10:09 am, edited 1 time in total.
On Windows 10: LibreOffice 6.1 and older versions, PortableOpenOffice 4.1.5 and older, StarOffice 5.2
---
Let's create a powerful UFO: United Free Office!
Lupp from München
User avatar
Lupp
Volunteer
 
Posts: 2042
Joined: Sat May 31, 2014 7:05 pm
Location: München, Germany

Re: [Solved] Color Macro from MS Excel into Calc

Postby Tennisdad » Wed Sep 14, 2016 12:12 pm

Thanks for the reply and the info.

Apologies, I wasn't being sarcastic and in no way intended to be to be interpreted as such. I am a complete noob to Open Office and consider myself to be in illustrious company. Regarding the topic, you are completely correct, I am still tiddling with the Excel version trying to do the same thing and reading previous comments from Villeroy regarding focusing on the data, decided on a rethink. I originally intended to use CF Formula to determine if cell A's value (opponents rating) was equal to or less than cell B (my son's rating) and if the condition was satisfied (oppo's rating was equal or higher) It then coloured Cell C ( opponents name, Green for a ratings win). I then used a 'macro function' to count the colours. It nearly worked, but wouldn't count colours 'generated' by the CF, only colours that were manually inserted!! Now, instead of counting the colours, I count the number of Cells A with the required value, far better and it even works! All I have to do now is fix/apply this to the Open Office version!!

Apologies if any offence caused, especially to Villeroy, and thanks again.
OpenOffice 4.1.2 on Windows 8.1
Tennisdad
 
Posts: 5
Joined: Mon Sep 12, 2016 7:52 pm

Re: [Solved] Color Macro from MS Excel into Calc

Postby Villeroy » Thu Sep 15, 2016 2:33 pm

All you need is a 2-column list with competitor names and result. This would be the minimum of information and you could apply a most simple conditional format formula.
Create 2 styles, say "loss" and "win".
Apply the "loss" formatting to the whole list.
Select the list, say A2:B100, and notice the position of the cell cursor (the active input cell), say A2.
Condition 1, "Formula" instead of "Cell Value"
Formula: $B2 (absolute column, relative row)
Style: "win".
If $B2 (this row's value in B) evaluates to TRUE, then apply cell style "win". A spreadsheet cell evaluates to true when it contains any number other than zero.
Please, edit this topic's initial post and add "[Solved]" to the subject line if your problem has been solved.
Ubuntu 18.04, OpenOffice 4.x & LibreOffice 6.x
User avatar
Villeroy
Volunteer
 
Posts: 25752
Joined: Mon Oct 08, 2007 1:35 am
Location: Germany

Re: [Solved] Color Macro from MS Excel into Calc

Postby Tennisdad » Thu Sep 15, 2016 6:09 pm

Thanks for the reply and suggestion, Villeroy (and your amendment, Lupp :-) )

I will bore you with some details!! The workbook was slightly complicated by the fact that, due to the vagaries of our Tennis system, a Win isn't necessarily a 'Ratings Win'. A win only counts as ratings win if it is against an equal or higher ranked player ( rankings go from 1.1, the highest!, to 10.2, the lowest). A ratings loss is a loss against a lower ranked player only. The ratings wins and losses are added up at the end of a season to decide if the players rating goes up (60% win/loss with at least 6 wins for a junior) or down ( only adults can go down). Hence the 'need' for a count. I have now followed pretty much what you have suggested, Villeroy, I have a Win column and a loss column with the oppo's name in and, next to each of these columns, a column for the oppo's rating. I have a CF 'formula' in each win oppo's cell testing the oppo's rating <= against a single 'absolute' cell with our ranking and it then colours the oppo's cell Green if it is a ratings win. The Formula in the Loss column does almost the same but with a > to colour a Ratings loss Red. At the bottom of the win column ( the end of the season) I have a Countif of the 'Win' rating cells <= against our rating and the 'same' only > against losses at the bottom of the Loss column. Whereas previously, foolishly, I was trying to count colours, thanks to your advice I am having a count of the 'data' that produces the colours! So I have a workbook that may not be elegant in it's methodology but at least works and it looks pretty :) . I may re-visit it at some time and factor-in a formula to check for 60% win/loss but I think that may, as we say, be egging it a bit!! I hope I have explained this OK, if so please explain it to me!

Thanks again for your help Villeroy and Lupp.
OpenOffice 4.1.2 on Windows 8.1
Tennisdad
 
Posts: 5
Joined: Mon Sep 12, 2016 7:52 pm

Re: [Solved] Color Macro from MS Excel into Calc

Postby Villeroy » Thu Sep 15, 2016 7:07 pm

Nevertheless, you can use constant data or calculation results rather than formatting attributes. One column describing the competitor and one formula column to calculate win or loss somehow. Then you may fetch the conditional formatting from that column. If this works well and reliably, you can move the entire formula to the conditional format level, leaving the other column conditionally formatted. There is no reason for switching to an inefficient macro langauge if the spreadsheet provides all the programming features.
Please, edit this topic's initial post and add "[Solved]" to the subject line if your problem has been solved.
Ubuntu 18.04, OpenOffice 4.x & LibreOffice 6.x
User avatar
Villeroy
Volunteer
 
Posts: 25752
Joined: Mon Oct 08, 2007 1:35 am
Location: Germany

Re: [Solved] Color Macro from MS Excel into Calc

Postby Tennisdad » Fri Sep 16, 2016 2:35 pm

Villeroy wrote:Nevertheless, you can use constant data or calculation results rather than formatting attributes. One column describing the competitor and one formula column to calculate win or loss somehow. Then you may fetch the conditional formatting from that column. If this works well and reliably, you can move the entire formula to the conditional format level, leaving the other column conditionally formatted. There is no reason for switching to an inefficient macro langauge if the spreadsheet provides all the programming features.


I'm very sorry Villeroy, but I fear you've lost me now :) .I am now only using Conditional Formatting ( using the formula I14<=$C$2, where Column I is the oppo's rating and C2 is our player's) for the colouring and Countif Function (=COUNTIF(I3:I35,"<="&$C$2) for the totaling. I wasn't aware that I was still using an inefficient macro language :?: .
Regards
OpenOffice 4.1.2 on Windows 8.1
Tennisdad
 
Posts: 5
Joined: Mon Sep 12, 2016 7:52 pm


Return to Macros and UNO API

Who is online

Users browsing this forum: No registered users and 5 guests