darle valor a un color de celda

¡Importante!: Colabora con el grupo.Contesta a este mensaje y dinos si te
sirvió o no la respuesta dada. Muchas gracias
Hola!

los colores de las celdas ya tienen su propio valor, mediante la siguiente
función puedes obtener el valor de las celdas de un color determinado


'*******************************************************************************
'* SumarColoreadas
'* devuelve la suma de las celdas del color pasado como parámetro o en su
'* defecto sin color de fondo o con fondo blanco
'* Argumentos: Rango => Rango de celdas a sumar
'* lngColor => (opcional) por defecto toma el color de la celda
en
'* que se ubica la función
'* uso: =SumarColoreadas(A1:D32)
'* Si utilizas este código, respeta la autoría y los créditos
'* ESH 29/10/07 21:11
'* ESH 25/02/13 12:08 incluido un nuevo parámetro opcional para seleccionar
el
'* color a acumular
'*******************************************************************************

Public Function SumarColoreadas(Rango As Range, Optional lngColor As Long)
As Double
Dim Celda As Range, _
dblTotal As Double

On Error GoTo SumarColoreadas_TratamientoErrores

' me aseguro de que se recalcule cada vez que lo haga la hoja
Application.Volatile True
' si no paso el color tomo el color de la celda destino
If lngColor = 0 Then
lngColor = Application.Caller.Interior.ColorIndex
End If
' recorro cada celda del rango
For Each Celda In Rango
' si el color de fondo no es blanco o no tiene, acumulo el valor en una
variable
If lngColor Then
If Celda.Interior.ColorIndex = lngColor Then
dblTotal = dblTotal + Celda
End If
Else
If Not (Celda.Interior.ColorIndex = xlNone Or
Celda.Interior.ColorIndex = 2) Then
dblTotal = dblTotal + Celda
End If
End If
Next Celda
' devuelvo el resultado
SumarColoreadas = dblTotal


SumarColoreadas_Salir:
On Error GoTo 0
Exit Function

SumarColoreadas_TratamientoErrores:
MsgBox "Error " & Err & " en proc.: SumarColoreadas de Módulo: Módulo1 ("
& Err.Description & ")", vbCritical + vbOKOnly, "ATENCION"
Resume SumarColoreadas_Salir

End Function ' SumarColoreadas
Saludos a todos desde Huelva

Emilio [MS-MVP Access 2006/11]
http://www.mvp-access.com/foro
http://www.mvp-access.es/emilio