[RESUELTO] Macro Contarcolor de letra
Publicado: Lun Dic 21, 2020 5:14 pm
Buenas tardes:
Me llamo David y he llegado a este foro buscando la forma de crear una formula/macro para que en una hoja de calculo me haga una suma dependiendo del color, NO DE LA CELDA, sino del color de la letra/numero. Es decir, los números por defecto tienen color negro y yo quiero que me haga una suma solamente los números que les pongo el color "rojo".
Tengo creada esta que he que la he sacado de algunos mensajes de este foro, que me funciona bien si lo que busco es colorear las celdas pero no es exactamente lo que necesito.
Function SUMARCOLOR(CeldaColor As String, RangoSuma As String) As Double
On Error Goto error
Dim oRango As Object
oRango = ThisComponent.CurrentController.ActiveSheet
oCelda = oRango.GetCellRangeByName(CeldaColor).CellBackColor
oRango = oRango.GetCellRangeByName(RangoSuma)
For c = 0 to oRango.Columns.Count - 1
For f = 0 to oRango.Rows.Count - 1
If oRango.GetCellByPosition(c,f).CellBackColor = oCelda Then
oCuenta = oRango.GetCellByPosition(c,f).Value + oCuenta
End If
Next
Next
SUMARCOLOR = oCuenta
error:
End Function
sub Actualizar
end sub
Si me pudierais decir que es lo que tengo que modificar o añadir para que funcione lo agradecería porque no doy con ello, sobre todo porque de programación no tengo ni idea.
Muchas gracias¡¡¡
Me llamo David y he llegado a este foro buscando la forma de crear una formula/macro para que en una hoja de calculo me haga una suma dependiendo del color, NO DE LA CELDA, sino del color de la letra/numero. Es decir, los números por defecto tienen color negro y yo quiero que me haga una suma solamente los números que les pongo el color "rojo".
Tengo creada esta que he que la he sacado de algunos mensajes de este foro, que me funciona bien si lo que busco es colorear las celdas pero no es exactamente lo que necesito.
Function SUMARCOLOR(CeldaColor As String, RangoSuma As String) As Double
On Error Goto error
Dim oRango As Object
oRango = ThisComponent.CurrentController.ActiveSheet
oCelda = oRango.GetCellRangeByName(CeldaColor).CellBackColor
oRango = oRango.GetCellRangeByName(RangoSuma)
For c = 0 to oRango.Columns.Count - 1
For f = 0 to oRango.Rows.Count - 1
If oRango.GetCellByPosition(c,f).CellBackColor = oCelda Then
oCuenta = oRango.GetCellByPosition(c,f).Value + oCuenta
End If
Next
Next
SUMARCOLOR = oCuenta
error:
End Function
sub Actualizar
end sub
Si me pudierais decir que es lo que tengo que modificar o añadir para que funcione lo agradecería porque no doy con ello, sobre todo porque de programación no tengo ni idea.
Muchas gracias¡¡¡