Cuadros Combinados Dependientes ComboBox

Algunas veces aplicamos en una Hoja de Cálculo Listas de Validación dependientes, pero en lugar de Listas de Validación en esta ocasión usare “Cuadros Combinados Dependientes ComboBox”.

Lo primero que debemos de tener es una Base de Datos de Origen, y que se cargaran en los diferentes ComboBox. En este caso usare dos ComboBox, aunque su funcionamiento es el mismo, si anidamos más de dos ComboBox dependientes.

Para explicar el funcionamiento de estos ejemplos, supongamos que tenemos una lista de Grupos con sus respectivos Nombres de Cliente o Empresa. En este ejemplo de ComboBox dependiente hay 2 grupos, uno de Clientes y Otro de Proveedores con sus nombres aunque si deseamos podemos añadir más Grupos, y también más nombres como se ve en la siguiente Imagen de ejemplo:


A continuación, Tenemos el Siguiente Formulario, donde tenemos dos Cuadros Combinados, dependiendo del grupo que hayamos seleccionado así se nos mostrare los datos. Observa la imagen de abajo y veras y veras dos cuadro combinados.

A continuación, este código es el que utilizo para realizar los ComboBox Dependientes:

Private Sub ComboBox1_Change()

ComboBox2.Clear

Grupos = ComboBox1

fila = 25

Do Until Sheets(“Inicio”).Cells(fila, 2) = “”

If Sheets(“Inicio”).Cells(fila, 3) = Grupos Then

ComboBox2.AddItem Sheets(“Inicio”).Cells(fila, 4)

fila = fila + 1

Else

fila = fila + 1

End If

Loop

Label2 = ComboBox1

End Sub

 Al Iniciar el Formulario se cargaran los Grupo al Primer ComboBox

Private Sub UserForm_Initialize()

Label2 = ComboBox1

fila = 25

Do Until Sheets(“Inicio”).Cells(fila, 1) = “”

ComboBox1.AddItem Sheets(“Inicio”).Cells(fila, 1)

fila = fila + 1

Loop

End Sub

 

Añadiremos también otros códigos, Referente a pequeñas funciones y macros, al igual Insertaremos también un módulo VBA al contiene funciones importantes referentes a los Cuadros de Texto.

Código de Mensaje de Bienvenida al abrir este Archivo:

Private Sub Workbook_Open()

hora_actual = Hour(Now())

If hora_actual < 12 Then

mensage_1 = “Buenos dias!”

ElseIf hora_actual <= 18 Then

mensage_1 = “Buenas Tardes!”

Else

mensage_1 = “Buenas Noches!”

End If

dia_semana = Format(Date, “dddd”)

Dia = Format(Date, “dd”)

mes = Format(Date, “mmmm”)

Año = Format(Date, “yyyy”)

mensage_2 = StrConv(dia_semana, vbProperCase) & “, ” & Dia & ” de ” & mes & ” de ” & Año

Beep

MsgBox mensage_1 + vbCrLf + vbCrLf + mensage_2, vbOKOnly + vbInformation, “Macro-Excel”

End Sub

Código de Registro de ENTRADA al Abrir este Archivo:

Private Sub Workbook_Open()

Dim uFila As Long

Dim ws As Worksheet

Set ws = Worksheets(“Registro”)

uFila = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row

ws.Cells(uFila, 1) = “Entrada”

ws.Cells(uFila, 2) = Application.UserName

ws.Cells(uFila, 3) = Date & ” ” & Time

ActiveWorkbook.Save

End Sub

 Código de Registro de SALIDA al Cerrar este Archivo:

Private Sub Workbook_BeforeClose(Cancel As Boolean)

Dim uFila As Long

Dim ws As Worksheet

Set ws = Worksheets(“Registro”)

uFila = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row

ws.Cells(uFila, 1) = “Salida”

ws.Cells(uFila, 2) = Application.UserName

ws.Cells(uFila, 3) = Date & ” ” & Time

ActiveWorkbook.Save

End Sub

Código que calcula la fecha límite del Archivo o la Caducidad:

Dim FechaCaducidad As Date

FechaCaducidad = #1/31/2025#

If FechaCaducidad > Date Then

MsgBox “Estimado Amigo dentro de :   ” & FechaCaducidad – Date & ” días, Se Eliminara por Completo este Archivo.”, vbInformation, “Fecha de Caducidad”

Else

MsgBox “Uppppssss lo Sietno!!!, Pero ya estabas Advertido…” & vbCrLf & ” que este Archivo se Elimimo de su Ordenador.”, vbCritical, “Fecha de Caducidad”

Application.DisplayAlerts = False

ActiveWorkbook.ChangeFileAccess xlReadOnly

Kill ActiveWorkbook.FullName

ThisWorkbook.Close

End If

End Sub

 Código para validar los cuadros de texto:

Usando UCASE es para validar a que acepte solo letras Mayúsculas.

Private Sub TextBox1_Change()

TextBox1 = UCase(TextBox1)

End Sub

Usando LCASE es para validar a que acepte solo letras Minúsculas.

Private Sub TextBox2_Change()

TextBox2 = LCase(TextBox2)

End Sub

Código para validar los cuadros de texto a más funciones:

Cuadro de Texto que solo acepte NÚMERO:

Function SoloNumero(Texto As Variant)

Dim Caracter As Variant

Dim Largo As Integer

On Error Resume Next

Largo = Len(Texto)

For i = 1 To Largo

Caracter = Mid(CStr(Texto), i, 1)

If Caracter <> “” Then

If Caracter < Chr(48) Or Caracter > Chr(57) Then

Texto = Replace(Texto, Caracter, “”)

SoloNumero = Texto

Else

End If

End If

Next i

SoloNumero = Texto

On Error GoTo 0

End Function

Cuadro de Texto que solo acepte TEXTO:

Function SoloTexto(Texto As Variant)

Dim Caracter As Variant

Dim Largo As String

On Error Resume Next

Largo = Len(Texto)

For i = 1 To Largo

Caracter = CInt(Mid(Texto, i, 1))

If Caracter <> “” Then

If Not Application.WorksheetFunction.IsText(Caracter) Then

Texto = Replace(Texto, Caracter, “”)

SoloTexto = Texto

Else

End If

End If

Next i

SoloTexto = Texto

On Error GoTo 0

End Function

Cuadro de Texto que solo acepte NÚMERO & DECIMAL:

Function SoloNumeroDecimal(Texto As Variant)

Dim Caracter As Variant

Dim Largo As Integer

On Error Resume Next

Punto = 0

Largo = Len(Texto)

For i = 1 To Largo

Caracter = Mid(CStr(Texto), i, 1)

If Caracter <> “” Then

If Caracter = Chr(46) Then

Punto = Punto + 1

If Punto > 1 Then

Texto = WorksheetFunction.Replace(Texto, i, 1, “”)

SoloNumeroDecimal = Texto

Punto = 0

End If

Else

If Caracter < Chr(48) Or Caracter > Chr(57) Then

Texto = Replace(Texto, Caracter, “”)

SoloNumeroDecimal = Texto

Else

End If

End If

End If

Next i

SoloNumeroDecimal = Texto

On Error GoTo 0

End Function

 Evento CHANGE de cada Cuadro de Texto:

Private Sub txtNumero_Change()

Me.txtNumero.Value = SoloNumero(Me.txtNumero.Value)

End Sub

Private Sub txtNumeroDecimal_Change()

Me.txtNumeroDecimal.Value = SoloNumeroDecimal(Me.txtNumeroDecimal.Value)

End Sub

Private Sub txtTexto_Change()

Me.txtTexto.Value = SoloTexto(Me.txtTexto.Value)

End Sub

Desde aquí podrás Descargar el Archivo de Excel, que es la base de este ejemplo.

Demostración de este Ejemplo y la función de cada Campo:    VER VÍDEO


  https://goo.gl/iQRzhu “Canal de Aguirre”

  https://goo.gl/FS4UcZ “Canal MacroExcel” Próximamente todos los vídeos disponibles aquí”

  https://goo.gl/qKpNFe “Pagina Oficial MacroExcel”

  https://goo.gl/cQQ7Gi “Facebook MacroExcel – ME”
❗Recuerda también: contamos con un grupo privado síguenos y envíanos la solicitud si deseas ayuda y aportar en la comunidad “MacroExcel – ME”

Categorías: Macros

Deja un comentario

WhatsApp Necesitas Ayuda?
A %d blogueros les gusta esto: