moduloColor_2010_06_03.bas

  1. Attribute VB_Name = "moduloColor_2010_06_03"
  2. Option Explicit
  3.  
  4. 'Gestión del color
  5. '2009-III-25 <fco@proinf.net>
  6. '2009-IV-23 - Color par e impar
  7.  
  8. '------------------------------------------------
  9. ' INDICES DE COLOR
  10. '------------------------------------------------
  11.  
  12. Public Const COLOR_PAR = 0
  13. Public Const COLOR_IMPAR = 1
  14.  
  15. Public Const COLOR_NEGRO = 1
  16. Public Const COLOR_BLANCO = 2
  17. Public Const COLOR_ROJ0 = 3
  18.  
  19. Public Const COLOR_TURQUESA = 8
  20.  
  21. Public Const COLOR_GRIS = 15
  22. Public Const COLOR_PLOMO = 16
  23.  
  24. Public Const COLOR_CELESTE = 34
  25. Public Const COLOR_MENTA = 35
  26. Public Const COLOR_VAINILLA = 36
  27. Public Const COLOR_CIELO = 37
  28. Public Const COLOR_ROSA = 38
  29. Public Const COLOR_LAVANDA = 39
  30. Public Const COLOR_CANELA = 40
  31.  
  32. Public Const COLOR_AGUAMARINA = 42
  33.  
  34. Public Const COLOR_ANARANJADO = 45
  35. Public Const COLOR_NARANJA = 46
  36.  
  37. Public Const COLOR_CENIZA = 56
  38.  
  39. '------------------------------------------------
  40. ' FUNCIONES PRUEBA
  41. '------------------------------------------------
  42.  
  43. Public Sub PruebaModuloColor()
  44. Call ColorearTresGrupos(Range("datos"), 2, 2, 2)
  45. End Sub
  46.  
  47. '------------------------------------------------
  48. ' FUNCIONES
  49. '------------------------------------------------
  50.  
  51. Public Function ColorearFilas( _
  52. celdaDentroRango As Range, _
  53. indiceColorImpar As Integer, _
  54. indiceColorPar As Integer, _
  55. columnaInicio As Integer, _
  56. columnaFin As Integer _
  57. )
  58. 'Colorea cebrando las filas desde y hasta las columnas indicadas
  59. 'Ignora la primera fila porque se considera que es una fila de títulos
  60. '2009-III-25 <fco@proinf.net>
  61.  
  62. Dim tabla As Range
  63. Dim celda As Range
  64. Dim par As Boolean
  65. Dim indiceColor As Integer
  66.  
  67. Set tabla = celdaDentroRango.CurrentRegion.Offset(, columnaInicio - 1).Resize(, columnaFin - columnaInicio + 1)
  68.  
  69. 'Eliminar fila de titulos
  70. Set tabla = tabla.Offset(1).Resize(tabla.Rows.Count - 1)
  71.  
  72. For Each celda In tabla.Cells
  73. par = (celda.Row Mod 2) = 0
  74. indiceColor = IIf(par, indiceColorPar, indiceColorImpar)
  75. celda.Interior.ColorIndex = indiceColor
  76. Next
  77.  
  78. End Function
  79.  
  80. Public Function Colorear(ParamArray params())
  81. 'Colorea el fondo de los rangos indicados con los colores indicados
  82. 'Ejemplo: Call Colorear (COLOR_ROJO, Range("A1:A4"), Range("B3"), COLOR_AZUL, Range("C2"))
  83. '2009-IV-1 <fco@proinf.net>
  84.  
  85. Dim indiceColor As Integer
  86. Dim rango As Range
  87. Dim elemento As Variant
  88.  
  89. For Each elemento In params
  90. If IsObject(elemento) Then
  91. Set rango = elemento
  92. If indiceColor <> 0 Then
  93. rango.Interior.ColorIndex = indiceColor
  94. If indiceColor = COLOR_NEGRO Or indiceColor = COLOR_PLOMO Then
  95. rango.Font.ColorIndex = COLOR_BLANCO
  96. End If
  97. End If
  98. ElseIf IsNumeric(elemento) Then
  99. indiceColor = elemento
  100. End If
  101. Next
  102. End Function
  103.  
  104. Public Function CebrarFilas( _
  105. rango As Range, _
  106. Optional ByVal indiceColorPar = COLOR_BLANCO _
  107. ) As Boolean
  108. 'Colorea las filas pares del rango indicado.
  109. '2009-IV-3
  110. Dim fila As Range
  111. Dim indiceFila As Integer, numFilas As Integer
  112. Dim esPar As Boolean
  113.  
  114. numFilas = rango.Rows.Count
  115.  
  116. Set fila = rango.Resize(1)
  117. For indiceFila = 1 To numFilas
  118. If esPar Then
  119. fila.Interior.ColorIndex = indiceColorPar
  120. End If
  121. esPar = Not esPar
  122. Set fila = fila.Offset(1)
  123. Next
  124.  
  125. End Function
  126.  
  127. Public Function Cuadricular( _
  128. rango As Range _
  129. ) As Boolean
  130. 'Bordea las celdas del rango indicado
  131. '2009-IV-5
  132.  
  133. With rango.Borders
  134. .LineStyle = xlContinuous
  135. .Weight = xlThin
  136. .ColorIndex = COLOR_PLOMO
  137. End With
  138.  
  139. End Function
  140.  
  141.  
  142. Public Function ColorearColumnas( _
  143. rango As Range, _
  144. numElementos As Integer, _
  145. indicesColor As Variant _
  146. ) As Boolean
  147. 'Colorea de N en N columnas con la lista de colores indicados.
  148. '2009-IV-5
  149. Dim columna As Range
  150. Dim indiceColumna As Integer, numColumnas As Integer
  151. Dim indiceElemento As Integer
  152. Dim indiceColor As Integer, numColores As Integer
  153.  
  154. numColumnas = rango.Columns.Count
  155. numColores = 1 ' UBound(indicesColor) + 1 '2010-VI-3
  156.  
  157. Set columna = rango.Resize(, 1)
  158. For indiceColumna = 1 To numColumnas
  159.  
  160. With columna.Interior
  161. .ColorIndex = indicesColor(indiceColor)
  162. End With
  163.  
  164. indiceElemento = indiceElemento + 1
  165. If indiceElemento >= numElementos Then
  166. indiceElemento = 0
  167. End If
  168.  
  169. indiceColor = indiceColor + 1 'indiceElemento '2010-VI-3
  170. If indiceColor >= numColores Then
  171. indiceColor = 0
  172. End If
  173.  
  174. Set columna = columna.Offset(, 1)
  175. Next
  176.  
  177. End Function
  178.  
  179. Public Function ColorearTresGrupos( _
  180. inicioRango As Range, _
  181. numColumnas1 As Integer, _
  182. numColumnas2 As Integer, _
  183. numColumnas3 As Integer _
  184. )
  185. 'Colorea cebrando las filas de tres grupos de columnas consecutivos
  186. '2009-III-25 <fco@proinf.net>
  187. '2010-VI-3 - Nuevos colores
  188.  
  189. Dim columnaInicio As Integer
  190. Dim columnaFin As Integer
  191.  
  192. columnaInicio = columnaFin + 1
  193. columnaFin = columnaInicio + numColumnas1 - 1
  194. Call ColorearFilas(inicioRango, COLOR_CIELO, COLOR_BLANCO, columnaInicio, columnaFin)
  195.  
  196. columnaInicio = columnaFin + 1
  197. columnaFin = columnaInicio + numColumnas2 - 1
  198. Call ColorearFilas(inicioRango, COLOR_CANELA, COLOR_BLANCO, columnaInicio, columnaFin)
  199.  
  200. columnaInicio = columnaFin + 1
  201. columnaFin = columnaInicio + numColumnas3 - 1
  202. Call ColorearFilas(inicioRango, COLOR_MENTA, COLOR_BLANCO, columnaInicio, columnaFin)
  203. End Function
  204.  
  205. '------------------------------------------------
  206. 'Color definido para las filas impares y pares de la tabla destino.
  207.  
  208. Public Function ColorColumnas(Optional numColor As Integer) As Integer
  209. Select Case numColor Mod 2
  210. Case COLOR_PAR: ColorColumnas = COLOR_CELESTE 'COLOR_ANARANJADO
  211. Case COLOR_IMPAR: ColorColumnas = COLOR_CIELO 'COLOR_NARANJA
  212. End Select
  213. End Function
  214. Public Function ColorFilas(Optional numColor As Integer) As Integer
  215. Select Case numColor Mod 2
  216. Case COLOR_PAR: ColorFilas = COLOR_CELESTE 'COLOR_TURQUESA
  217. Case COLOR_IMPAR: ColorFilas = COLOR_CIELO 'COLOR_AGUAMARINA
  218. End Select
  219. End Function
  220. Public Function ColorDatos(Optional numColor As Integer) As Integer
  221. Select Case numColor Mod 2
  222. Case COLOR_PAR: ColorDatos = COLOR_BLANCO
  223. Case COLOR_IMPAR: ColorDatos = COLOR_MENTA
  224. End Select
  225. End Function
  226. Public Function colorTitulos(Optional numColor As Integer) As Integer
  227. colorTitulos = COLOR_PLOMO
  228. End Function
  229. Public Function colorFormula(Optional numColor As Integer) As Integer
  230. colorFormula = COLOR_GRIS
  231. End Function
  232.  
  233. '------------------------------------------------
  234.  

Proinf.net