Desplegable en el campo de un formulario
Para Dante Amor
¿Cómo puedo poner un desplegable en el campo de un formulario? Es para el campo "CENTRO" del proyecto en el que me has ayudado en las otras preguntas :)
1 Respuesta
Respuesta de Dante Amor
1
H o l a:
Te anexo las macros actualizadas
Dim colTbxs As Collection 'Collection Of Custom Textboxes
'
Private Sub CommandButton1_Click()
'Por.Dante Amor
'ingresar clientes
If tb_centro = "" Then cad = "Centro. "
'If tb_nombre = "" Then cad = cad & "Nombre. "
If tb_nif = "" Then cad = cad & "Nif. "
If cad <> "" Then MsgBox "Faltan los datos: " & cad: Exit Sub
'
existe = False
hoja = UCase(tb_centro)
For Each h In Sheets
If h.Name = hoja Then
existe = True
Exit For
End If
Next
If existe = False Then
res = MsgBox("No existe la hoja con el centro: " & hoja & vbCr & vbCr & _
"Desea crear la hoja", vbQuestion + vbYesNo, "CREAR HOJA")
If res = vbYes Then
Set h1 = Sheets.Add(after:=Sheets(Sheets.Count))
h1.Name = hoja
Sheets(1).Rows(1).Copy h1.[A1]
u = Sheets(hoja).Range("A" & Rows.Count).End(xlUp).Row + 1
Call PasarDatos(hoja, u)
Else
tb_centro.SetFocus
Exit Sub
End If
Else
u = Sheets(hoja).Range("A" & Rows.Count).End(xlUp).Row + 1
Call PasarDatos(hoja, u)
End If
End Sub
'
Sub PasarDatos(hoja, fila)
'Por.Dante Amor
'PasarDatos a la hoja
Sheets(hoja).Cells(fila, "A") = tb_centro
Sheets(hoja).Cells(fila, "B") = tb_alta
Sheets(hoja).Cells(fila, "C") = TextBox1
Sheets(hoja).Cells(fila, "D") = tb_nombre
Sheets(hoja).Cells(fila, "E") = tb_apellido1
Sheets(hoja).Cells(fila, "F") = tb_apellido2
Sheets(hoja).Cells(fila, "G") = tb_edad
Sheets(hoja).Cells(fila, "H") = tb_nif
Sheets(hoja).Cells(fila, "I") = tb_telefono
Sheets(hoja).Cells(fila, "J") = tb_email
Sheets(hoja).Cells(fila, "K") = tb_facebook
For Each ctrl In Me.Controls
If TypeName(ctrl) = "TextBox" Then ctrl.Value = ""
Next
tb_centro = ""
ListBox1.RowSource = ""
Label1 = ""
Label2 = ""
tb_alta = Date
MsgBox "Cliente Modificado"
End Sub
'
Private Sub CommandButton2_Click()
'Por.Dante Amor
'Modificar
If Label1 = "" Or Label2 = "" Then
MsgBox "Debes seleccionar un registro de la lista"
Exit Sub
End If
If tb_centro <> Label1 Then
MsgBox "No puedes cambiar el centro"
tb_centro.SetFocus
Exit Sub
End If
'
Call PasarDatos(Label1.Caption, Val(Label2.Caption))
End Sub
'
Private Sub ListBox1_Click()
'Seleccionar cliente
tb_centro = ListBox1.List(ListBox1.ListIndex, 0)
tb_alta = ListBox1.List(ListBox1.ListIndex, 1)
TextBox1 = ListBox1.List(ListBox1.ListIndex, 2)
tb_nombre = ListBox1.List(ListBox1.ListIndex, 3)
tb_apellido1 = ListBox1.List(ListBox1.ListIndex, 4)
tb_apellido2 = ListBox1.List(ListBox1.ListIndex, 5)
tb_edad = ListBox1.List(ListBox1.ListIndex, 6)
tb_nif = ListBox1.List(ListBox1.ListIndex, 7)
tb_telefono = ListBox1.List(ListBox1.ListIndex, 8)
tb_email = ListBox1.List(ListBox1.ListIndex, 9)
tb_facebook = ListBox1.List(ListBox1.ListIndex, 10)
Label1 = ListBox1.List(ListBox1.ListIndex, 11)
Label2 = ListBox1.List(ListBox1.ListIndex, 12)
End Sub
'
Private Sub CommandButton3_Click()
'Por.Dante Amor
'Consultar
Set hf = Sheets("Filtro")
hf.Cells.Clear
ListBox1.RowSource = ""
j = 2
Sheets(1).Rows(1).Copy hf.Rows(1)
For Each h In Sheets
If h.Name <> hf.Name Then
For i = 2 To h.Range("A" & Rows.Count).End(xlUp).Row
If h.Cells(i, "A") Like "*" & tb_centro & "*" Then
If h.Cells(i, "B") Like "*" & tb_alta & "*" Then
If h.Cells(i, "C") Like "*" & TextBox1 & "*" Then
If h.Cells(i, "D") Like "*" & tb_nombre & "*" Then
If h.Cells(i, "E") Like "*" & tb_apellido1 & "*" Then
If h.Cells(i, "F") Like "*" & tb_apellido2 & "*" Then
If h.Cells(i, "G") Like "*" & tb_edad & "*" Then
If h.Cells(i, "H") Like "*" & tb_nif & "*" Then
If h.Cells(i, "I") Like "*" & tb_telefono & "*" Then
If h.Cells(i, "J") Like "*" & tb_email & "*" Then
If h.Cells(i, "K") Like "*" & tb_facebook & "*" Then
h.Rows(i).Copy hf.Rows(j)
hf.Cells(j, "L") = h.Name
hf.Cells(j, "M") = i
j = j + 1
End If: End If: End If: End If: End If: End If
End If: End If: End If: End If: End If
Next
End If
Next
u = hf.Range("A" & Rows.Count).End(xlUp).Row
If u = 1 Then
MsgBox "No hay coincidencias"
Else
ListBox1.RowSource = hf.Name & "!A2:M" & u
End If
End Sub
'
Private Sub tb_centro_Change()
tb_centro.Text = UCase(tb_centro.Text)
End Sub
'
Private Sub tb_telefono_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
'Por.Dante Amor
If Not (KeyAscii >= 48 And KeyAscii <= 57) Then KeyAscii = 0
End Sub
Private Sub tb_edad_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If Not (KeyAscii >= 48 And KeyAscii <= 57) Then KeyAscii = 0
End Sub
Private Sub UserForm_Activate()
tb_alta = Date
For Each h In Sheets
Select Case h.Name
Case "Filtro"
Case Else: tb_centro.AddItem h.Name
End Select
Next
End Sub
'
Private Sub UserForm_Initialize()
Dim ctlLoop As MSForms.Control
Dim clsObject As Clase1
Set colTbxs = New Collection
For Each ctlLoop In Me.Controls
Select Case ctlLoop.Name
Case "tb_nombre", "tb_apellido1", "tb_apellido2"
Set clsObject = New Clase1
Set clsObject.tbxCustom1 = ctlLoop
colTbxs.Add clsObject
End Select
Next ctlLoop
End Sub
Private Sub UserForm_Terminate()
Set colTbxs = Nothing
End Sub
Private Sub BT_SALIR_Click()
Unload Me
End SubSal u dos
