[RESUELTO] Macro Contarcolor de letra

Desarrollo de Macros y programación en UNO, usar las API, llamar programas externos...
Responder
dabinchii
Mensajes: 4
Registrado: Lun Dic 21, 2020 5:00 pm

[RESUELTO] Macro Contarcolor de letra

Mensaje por dabinchii »

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¡¡¡
Última edición por dabinchii el Lun Dic 21, 2020 8:08 pm, editado 1 vez en total.
OpenOffice 7.0.3.1 - SO windows 8.1
FJCC-ES
Mensajes: 873
Registrado: Mié Mar 25, 2009 1:19 am
Ubicación: Colorado, USA

Re: Macro Contarcolor de letra

Mensaje por FJCC-ES »

Use CharColor en vez de CellBackColor.

Código: Seleccionar todo

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).CharColor
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).CharColor = oCelda Then
oCuenta = oRango.GetCellByPosition(c,f).Value + oCuenta
End If
Next
Next
SUMARCOLOR = oCuenta
error:
End Function
dabinchii
Mensajes: 4
Registrado: Lun Dic 21, 2020 5:00 pm

Macro Contarcolor de letra

Mensaje por dabinchii »

Ahora siii...... MUCHAS GRACIAS ¡¡¡¡
OpenOffice 7.0.3.1 - SO windows 8.1
Responder