Los botones de opción se utilizan para elegir una única opción entre una serie de ellas, es decir, de un grupo de opciones sólo permitirán que se escoja una. De la misma forma que las casillas de verificación, casi siempre implican una estructura condicional para comprobar cual de ellas está activada. El botón activado tendrá su propiedad Value igual a true.
Como ejemplo de su utilización crearemos dos botones de opción que sirvan para que a la hora de copiar datos hacia la hoja, se copie sólo los valores de Nombre y Apellidos o todos como hasta ahora.
Incluya dos botones de opción y establezca las siguientes propiedades.
Botón1.
Name, Todo.
Caption, Todo.
Botón2.
Name, Solo_Nombre.
Caption, Nombre y Apellidos.
Si está activado el primer botón deberán copiarse todos los datos mientras que si está activado el segundo solo se copiarán el Nombre y los Apellidos. El procedimiento Copiar_Datos_Hojas quedará de la forma siguiente.
Private Sub Copiar_Datos_Hojas(r1 As Range, r2 As Range)
Dim i As Integer
Dim Datos As Variant
Dim Final As Integer
' Si Botón Todo Activado, se copian todas las columnas
If Todo.Value = True Then
Final = Num_Columnas - 1
Else ' Sólo se copian las dos primera columnas
Final = 1
End If
' recorrer las columnas del registro y copiar celda a celda
For i = 0 To Final
' Si la casilla Mayúsculas está activada y el tipo de datos es String
If Mayusculas.Value = True And TypeName(r1.Offset(0, i).Value) = "String" Then
Datos = UCase(r1.Offset(0, i).Value)
Else
Datos = r1.Offset(0, i).Value
End If
r2.Offset(0, i).Value = Datos
Next i
End Sub
Y aquí terminamos el estudio de cómo se pueden utilizar los controles de formulario dentro de una hoja de cálculo. Recordarle para terminar que debe ser extremadamente cuidadoso con el código que utilice en los procedimientos de evento sobre todo si los controles se interrelacionan entre ellos.
Option Explicit
' Numero de columnas(campos) de las que consta cada registro
Const Num_Columnas = 6
Private Sub Copiar_Datos_Click()
Dim i As Integer
Dim x As Integer
' Recoger el elemento seleccionado de la lista
i = Lista_Campos.ListIndex
' Si i < 0 no está seleccionado ningún elemento
If i < 0 Then
MsgBox ("Debe Seleccionar un campo de la lista")
Else
x = Lista_Comparacion.ListIndex
If x < 0 Then
MsgBox ("Debe Seleccionar uno operador de Comparación")
Else
' llamar a proceder
Call Proceder(i)
End If
End If
End Sub
' Procedimiento Proceder
' Inicia la copia de los datos coincidentes
' Parámetros:
' Columna = Elementos seleccionado de la lista que coincidirá
' con la columna sobre la que se debe buscar
Private Sub Proceder(Columna As Integer)
Dim r1 As Range, r2 As Range
Dim encontrado As Boolean
Dim Valor_Comparacion As Boolean
Dim Signo As Integer
Dim Tipo_Datos As String
' Si el cuadro de texto está vacío, no se busca nada
If Len(Datos_Buscar.Value) = 0 Then
MsgBox ("No hay datos que buscar")
Else
' Borrar los datos actuales
Call borrar_datos
' Activar Casilla A16 de Hoja2 y referenciarla con r2
' Es la casilla donde se copiarán los datos en caso que se encuentren
Worksheets(2).Range("A16").Activate
Set r2 = ActiveCell
' Activar casilla A2 de Hoja1 y referenciarla con r1
Worksheets(1).Activate
Worksheets(1).Range("A2").Activate
' Recorrer todo el rango de datos de Hoja1
encontrado = False
Do While Not IsEmpty(ActiveCell)
' Recoger el Signo de comparación
Signo = Lista_Comparacion.ListIndex
' recoger el tipo de datos
Tipo_Datos = Lista_Campos.Column(1, Columna)
Valor_Comparacion = Comparar(ActiveCell.Offset(0, Columna).Value, _
Datos_Buscar.Value, Signo, Tipo_Datos)
If Valor_Comparacion = True Then
encontrado = True
' Referenciar con r1 la celda donde están os datos
Set r1 = ActiveCell
' Copiar los datos
Call Copiar_Datos_Hojas(r1, r2)
' Referenciar con r2 la casilla donde se copiaran los próximos datos
Set r2 = r2.Offset(1, 0)
End If
ActiveCell.Offset(1, 0).Activate
Loop
Worksheets(2).Activate
If encontrado Then
MsgBox ("Datos Copiados")
Else
MsgBox ("Ninguna coincidencia")
End If
End If
End Sub
' Función que compara dos valores con un operador relacional =, >, <, etc.
' La función devuelve True o False en función de la comparación.
' Parámetros.
' Valor1 y Valor2 = Valores que se comparan
' Signo = variable que sirve para escoger el operador relacional
' en función de su valor, ver estructura Select Case
Private Function Comparar(Valor1 As Variant, Valor2 As Variant, Operador As Integer, Tipo As
String) As Boolean
Dim q As Boolean
Select Case Tipo
Case "N": ' Convertir a número
Valor2 = Val(Valor2)
Case "F": ' Convertir a Fecha
Valor2 = CDate(Valor2)
End Select
Select Case Operador
Case 0:
q = Valor1 = Valor2
Case 1:
q = Valor1 > Valor2
Case 2:
q = Valor1 < Valor2
Case 3:
q = Valor1 >= Valor2
Case 4:
q = Valor1 <= Valor2
End Select
Comparar = q
End Function
' Procedimiento para borrar los datos de Hoja2 se llama antes de proceder a la nueva copia
Private Sub borrar_datos()
Dim i As Integer
Worksheets(2).Range("A16").Activate
Do While Not IsEmpty(ActiveCell)
For i = 0 To Num_Columnas - 1
ActiveCell.Offset(0, i).Value = ""
Next i
ActiveCell.Offset(1, 0).Activate
Loop
End Sub
' Procedimiento para copiar los datos de Hoja1 a Hoja3
' Parámetros.
' r1 = Celda Origen
' r2 = Celda Destino
Private Sub Copiar_Datos_Hojas(r1 As Range, r2 As Range)
Dim i As Integer
Dim Datos As Variant
Dim Final As Integer
' Si Botón Todo Activado, se copian todas las columnas
If Todo.Value = True Then
Final = Num_Columnas - 1
Else ' Sólo se copian las dos primera columnas
Final = 1
End If
' recorrer las columnas del registro y copiar celda a celda
For i = 0 To Final
' Si la casilla Mayúsculas está activada y el tipo de datos es String
If Mayusculas.Value = True And TypeName(r1.Offset(0, i).Value) = "String" Then
Datos = UCase(r1.Offset(0, i).Value)
Else
Datos = r1.Offset(0, i).Value
End If
r2.Offset(0, i).Value = Datos
Next i
End Sub
Private Sub Datos_Buscar_Change()
' Si el numero de control está activado
If Numero.Enabled Then
' No permite coger valores superiores a la propiedad Max
If Val(Datos_Buscar.Value) > Numero.Max Then
MsgBox ("Valor demasiado grande")
Datos_Buscar.Value = Numero.Max
Else
' No permite coger valores inferiores a la propiedad Min
If Val(Datos_Buscar.Value) < Numero.Min Then
MsgBox ("Valor demasiado pequeño")
Datos_Buscar.Value = Numero.Min
Else
Numero.Value = Val(Datos_Buscar.Value)
End If
End If
End If
End Sub
Private Sub Lista_Campos_Change()
Dim i As Integer
Dim Tipo_Datos As String
i = Lista_Campos.ListIndex
If i >= 0 Then
Tipo_Datos = Lista_Campos.Column(1, i)
If Tipo_Datos = "N" Then
Numero.Enabled = True
If Lista_Campos.Value = "Edad" Then
Numero.Min = 18
Numero.Max = 99
Numero.SmallChange = 1
Datos_Buscar.Value = 0
Numero.Value=0
End If
If Lista_Campos.Value = "Cantidad" Then
Numero.Min = 10000
Numero.Max = 500000
Numero.SmallChange = 1000
Datos_Buscar .Value= 0
Numero.Value=0
End If
Else
Numero.Enabled = False
End If
End If
End Sub
Private Sub Numero_Change()
Datos_Buscar.Value = Numero.Value
End Sub
Technorati Tags: 
