moduloHojas_2009_05_12.bas

  1. Attribute VB_Name = "moduloHojas_2009_05_12"
  2. Option Explicit
  3.  
  4. 'Módulo Hojas
  5. '2009-V-7 versión 1.0 <fco@proinf.net>
  6. '2009-V-12
  7.  
  8. '------------------------------------------------
  9. ' CONSTANTES
  10. '------------------------------------------------
  11.  
  12. Public Const NUM_FILS_HOJA_CALCULO = 65536
  13. Public Const NUM_COLS_HOJA_CALCULO = 256
  14.  
  15. '------------------------------------------------
  16. ' FUNCIONES PRINCIPALES
  17. '------------------------------------------------
  18.  
  19. Public Function NuevoNombreHoja(Optional ByVal nombre As String = "") As String
  20. 'Obtiene un nombre de hoja válido que no esté duplicado.
  21. 'No crea la hoja sólo da el posible nombre que podría tener.
  22. '2009-V-7
  23. Dim nuevoNombre As String
  24. Dim contador As Integer
  25.  
  26. nombre = NormalizarNombreHoja(nombre)
  27. If nombre = "" Then
  28. nombre = "hoja"
  29. End If
  30.  
  31. nuevoNombre = nombre
  32. contador = 1
  33. Do Until Not ExisteNombreHoja(nuevoNombre)
  34. contador = contador + 1
  35. nuevoNombre = nombre & contador
  36. Loop
  37.  
  38. NuevoNombreHoja = nuevoNombre
  39.  
  40. End Function
  41.  
  42. Public Function BorrarDatosHoja(ByVal nombre As String) As Boolean
  43. '2009-V-7
  44. Worksheets(nombre).Range("A:IV").EntireColumn.Delete
  45. End Function
  46.  
  47. Public Function BorrarHojas(ByVal patron As String) As Boolean
  48. 'Borra todas las hojas cuyo nombre casen con el patrón indicado
  49. 'Ejemplo: BorrarHojas("grafico*") borra todas las hojas que se llamen grafico
  50. '2009-V-7
  51.  
  52. Dim lista As Variant
  53. Dim nombre As Variant
  54.  
  55. lista = ListaHojas(patron)
  56. Application.DisplayAlerts = False
  57. For Each nombre In lista
  58. Sheets(nombre).Delete
  59. Next
  60. Application.DisplayAlerts = True
  61.  
  62. End Function
  63.  
  64. '------------------------------------------------
  65. ' FUNCIONES AUXILIARES
  66. '------------------------------------------------
  67.  
  68. Private Function ListaHojas(ByVal patron As String) As Variant
  69. 'El patron puede tener asterisco delante, detrás o delante y detrás.
  70. 'Por ejemplo: "*hoja*" retorna todas los nombre de hoja que incluya la palabra hoja
  71. ' Join(ListaHojas("ejemplo*"),",")
  72. '2009-V-7
  73. Const ELEMENTO_SEPARADOR = "/"
  74.  
  75. Dim hoja As Object 'Ni Sheet ni Worksheet van bien
  76. Dim tipo As String
  77. Dim lista As String
  78. Dim nombre As String
  79. Dim ok As Boolean
  80.  
  81. If Left(patron, 1) = "*" And Right(patron, 1) = "*" Then
  82. tipo = "CONTIENE"
  83. ElseIf Left(patron, 1) = "*" Then
  84. tipo = "ACABA"
  85. ElseIf Right(patron, 1) = "*" Then
  86. tipo = "EMPIEZA"
  87. Else
  88. tipo = "ES"
  89. End If
  90. patron = Replace(patron, "*", "")
  91.  
  92. For Each hoja In Sheets
  93. nombre = hoja.Name
  94. ok = False
  95. Select Case tipo
  96. Case "ES": ok = patron = nombre
  97. Case "EMPIEZA": ok = patron = Left(nombre, Len(patron))
  98. Case "ACABA": ok = patron = Right(nombre, Len(patron))
  99. Case "CONTIENE": ok = 0 <> InStr(nombre, patron)
  100. End Select
  101. If ok Then
  102. If lista <> "" Then lista = lista & ELEMENTO_SEPARADOR
  103. lista = lista & nombre
  104. End If
  105. Next
  106. ListaHojas = Split(lista, ELEMENTO_SEPARADOR)
  107. End Function
  108.  
  109.  
  110. Private Function ExisteNombreHoja(ByVal nombre As String) As Boolean
  111. 'Comprueba si existe el nombre de hoja indicado en el libro actual
  112. '2009-V-7
  113.  
  114. Dim hoja As Object 'Ni Sheet ni Worksheet van bien
  115.  
  116. For Each hoja In Sheets
  117. If LCase(hoja.Name) = LCase(nombre) Then
  118. ExisteNombreHoja = True
  119. Exit Function
  120. End If
  121. Next
  122. ExisteNombreHoja = False
  123.  
  124. End Function
  125.  
  126. Private Function NormalizarNombreHoja(ByVal nombre As String) As String
  127. 'Deja sólos caracteres alfanuméricos, el guión, el guión bajo y el espacio
  128. 'Elimina el resto de caracteres entre ellos los acentos y signos de puntuación
  129. '2009-V-7
  130.  
  131. Const CARACTERES_VALIDOS = "abcdefghijklmnñopqrstuvwxyzABCDEFGHIJKLMNÑOPQRSTUVWXYZ0123456789-_ "
  132.  
  133. NormalizarNombreHoja = Trim(dejarAlgunosCaracteres(nombre, CARACTERES_VALIDOS))
  134. End Function
  135.  
  136.  
  137.  

Proinf.net