ClaseFormulario.cls

  1. VERSION 1.0 CLASS
  2. BEGIN
  3. MultiUse = -1 'True
  4. END
  5. Attribute VB_Name = "ClaseFormulario"
  6. Attribute VB_GlobalNameSpace = False
  7. Attribute VB_Creatable = False
  8. Attribute VB_PredeclaredId = False
  9. Attribute VB_Exposed = False
  10. Option Explicit
  11.  
  12. Private Const SEPARADOR = ","
  13.  
  14. 'Prefijo del nombre del control del formulario que se refiere a un campo de la hoja
  15. Private Const PREFIJO_CAMPO = "campo"
  16.  
  17. Private frm As UserForm
  18. Private ws As Worksheet
  19. Private fields() As String
  20.  
  21. 'El número de fila de los datos (sin incluir la fila de títulos)
  22. Private filaActual As Long
  23.  
  24. Private Function Tabla() As Range
  25. 'Retorna toda la tabla incluyendo la primera fila de títulos
  26. Set Tabla = ws.Range("a1").CurrentRegion
  27. End Function
  28.  
  29. Private Function Datos() As Range
  30. 'Retorna los datos de la tabla sin incluir la fila de títulos
  31. Set Datos = Tabla().Resize(Tabla().Rows.Count - 1).Offset(1)
  32. End Function
  33.  
  34. Private Function EsCampo(ctrl As Control) As Boolean
  35. 'If TypeOf ctrl Is TextBox Then 'No funciona en Excel
  36.  
  37. EsCampo = False
  38. If EmpiezaPor(ctrl.Name, PREFIJO_CAMPO) Then
  39. If TypeName(ctrl) = "TextBox" Or TypeName(ctrl) = "ComboBox" Then
  40. EsCampo = True
  41. End If
  42. End If
  43.  
  44. End Function
  45.  
  46.  
  47. Public Sub Nuevo()
  48. Dim ctrl As Control
  49. For Each ctrl In frm.Controls 'Por cada control que hay en el formulario
  50. If EsCampo(ctrl) Then
  51. ctrl.Value = ""
  52. End If
  53. Next
  54. filaActual = 0
  55. Mensaje = ""
  56. End Sub
  57.  
  58. Public Sub Mostrar()
  59. Dim ctrl As Control
  60. Dim indice As Integer
  61. Dim columna As Integer
  62. Dim valor As String
  63.  
  64. indice = 0
  65. Mensaje = ""
  66.  
  67. If filaActual > 1 Then
  68.  
  69. For Each ctrl In frm.Controls
  70. If EsCampo(ctrl) Then
  71. columna = buscarRango(fields(indice), Tabla().Rows(1))
  72. indice = indice + 1
  73.  
  74. If columna <> 0 Then
  75. valor = Datos().Cells(filaActual, columna)
  76. ctrl.Value = valor
  77. Else
  78. ctrl.Value = ""
  79. End If
  80. If indice > UBound(fields) Then
  81. Exit For
  82. End If
  83. End If
  84. Next
  85. End If
  86.  
  87. End Sub
  88.  
  89. Public Function Buscar(ByVal buscado As String, ParamArray nombresCampos()) As Boolean
  90.  
  91. Dim nombrecampo As Variant
  92. Dim columna As Long
  93. Dim Fila As Long
  94.  
  95. If Tabla().Rows.Count > 1 Then
  96.  
  97. For Each nombrecampo In nombresCampos
  98. columna = buscarRango(nombrecampo, Tabla().Rows(1))
  99. If columna <> 0 Then
  100. Fila = buscarRangoAproximado(buscado, Datos().Columns(columna))
  101. If Fila <> 0 Then
  102. Buscar = True
  103. filaActual = Fila
  104. Exit Function
  105. End If
  106. End If
  107. Next
  108. End If
  109. Buscar = False
  110.  
  111. End Function
  112.  
  113. Public Function BuscarTodos(ByVal buscado As String, ParamArray nombresCampos()) As Long
  114. 'Busca todas las coincidencias. Si hay más de una se mostrará la lista de
  115. 'coincidentes para que el usuario elija el más apropiado
  116.  
  117. Dim nombrecampo As Variant
  118. Dim columna As Long
  119. Dim Fila As Long
  120. Dim celda As Range
  121. Dim contador As Long
  122.  
  123. borrarTabla Range("coincidentes")
  124.  
  125. If Tabla().Rows.Count > 1 Then
  126.  
  127. For Each nombrecampo In nombresCampos
  128. columna = buscarRango(nombrecampo, Tabla().Rows(1))
  129. If columna <> 0 Then
  130.  
  131. Fila = 0
  132. For Each celda In Datos().Columns(columna).Cells
  133. Fila = Fila + 1
  134. If Contiene(celda.Value, buscado) Then
  135. agregarFilaTabla Range("coincidentes"), _
  136. Fila, _
  137. Datos().Cells(Fila, 1), _
  138. Datos().Cells(Fila, columna)
  139. If contador = 0 Then filaActual = Fila
  140. contador = contador + 1
  141. End If
  142. Next
  143. End If
  144. Next
  145. End If
  146.  
  147. If contador > 1 Then
  148. Set FormCoincidentes.ClaseForm = Me
  149. End If
  150.  
  151. BuscarTodos = contador
  152. End Function
  153.  
  154. Public Function Guardar() As Boolean
  155. Dim ctrl As Control
  156. Dim indice As Integer
  157. Dim columna As Integer
  158. Dim valor As String
  159.  
  160. indice = 0
  161. Guardar = False
  162.  
  163. 'Si es uno nuevo, añadirlo al final de la tabla
  164. If filaActual = 0 Then
  165. filaActual = Tabla().Rows.Count + 1
  166. End If
  167.  
  168. If filaActual > 1 Then
  169. For Each ctrl In frm.Controls
  170. If EsCampo(ctrl) Then
  171. columna = buscarRango(fields(indice), Tabla().Rows(1))
  172. indice = indice + 1
  173.  
  174. If columna <> 0 Then
  175. Datos().Cells(filaActual, columna) = ctrl.Value
  176. Guardar = True
  177. End If
  178. If indice > UBound(fields) Then
  179. Exit For
  180. End If
  181. End If
  182. Next
  183. End If
  184. End Function
  185.  
  186. Public Function Borrar() As Boolean
  187. If filaActual > 1 Then
  188.  
  189. If vbYes = MsgBox("¿Estás seguro que deseas borrar?", _
  190. vbExclamation + vbYesNo + vbDefaultButton2) _
  191. Then
  192. Datos().Rows(filaActual).Delete
  193. Borrar = True
  194. filaActual = 0
  195. End If
  196.  
  197. End If
  198.  
  199. End Function
  200.  
  201. Public Sub Cerrar()
  202. 'frm.Hide 'Oculta el formulario sin cerrarlo realmente
  203. Unload frm 'Descarga el formulario de la memoria
  204. End Sub
  205.  
  206. Public Property Let Mensaje(ByVal msg As String)
  207.  
  208. frm.etiquetaMensaje.Caption = msg
  209. If msg = "" Then
  210. frm.etiquetaMensaje.Visible = False
  211. Else
  212. frm.etiquetaMensaje.Visible = True
  213. If EmpiezaPor(msg, "ERROR:") Then
  214. frm.etiquetaMensaje.BackColor = vbRed
  215. Else
  216. frm.etiquetaMensaje.BackColor = vbYellow
  217. End If
  218. End If
  219.  
  220. End Property
  221.  
  222.  
  223. Public Property Get Formulario() As UserForm
  224. Set Formulario = frm
  225. End Property
  226. Public Property Set Formulario(ByVal vNewValue As UserForm)
  227. Set frm = vNewValue
  228. End Property
  229.  
  230. Public Property Get Hoja() As Worksheet
  231. Set Hoja = ws
  232. End Property
  233. Public Property Set Hoja(ByVal vNewValue As Worksheet)
  234. Set ws = vNewValue
  235. End Property
  236.  
  237. Public Property Get Campos() As String
  238. Campos = Join(fields, SEPARADOR)
  239. End Property
  240. Public Property Let Campos(ByVal vNewValue As String)
  241. 'Dim lista As Variant
  242. fields = Split(vNewValue, SEPARADOR)
  243. End Property
  244.  
  245. Public Property Get Fila() As Long
  246. Fila = filaActual
  247. End Property
  248. Public Property Let Fila(ByVal vNewValue As Long)
  249. filaActual = vNewValue
  250. End Property
  251.  
  252. Public Function EstaDuplicado(ByVal nombreColumna As String, ByVal valorBuscado As String) As Boolean
  253. 'Si filaActual contiene el valor buscado se considera no duplicado
  254.  
  255. Dim columna As Integer
  256. Dim valorActual As String
  257.  
  258. If Tabla().Rows.Count > 1 Then
  259. columna = buscarRango(nombreColumna, Tabla().Rows(1))
  260. If columna > 0 Then
  261.  
  262. If filaActual > 0 Then 'Si no es uno nuevo
  263. valorActual = Datos().Cells(filaActual, columna)
  264. If valorBuscado = valorActual Then
  265. EstaDuplicado = False
  266. Exit Function
  267. End If
  268. End If
  269.  
  270. If buscarRango(valorBuscado, Datos()) Then
  271. EstaDuplicado = True
  272. End If
  273. End If
  274. End If
  275. End Function
  276.  
  277.  
  278.  
  279.  
  280.  
  281.  
  282.  
  283.  
  284.  

Proinf.net