Condicionar campos de un formulario
Para Dante Amor
Continuando con la BBDD de la anterior pregunta y muy agradecido, ahora me gustaría condicionar algunos campos, como por ejemplo:
1. El campo ALTA, si es un cliente nuevo debe de poner la fecha actual.
2. Cualquier campo puede quedar vacío sin error, a excepción del campo "CENTRO" y "NIF"
3. Todos los campos deben de convertirse automáticamente a mayúsculas.
4. El campo "MÓVIL" solo permite 9 carácteres numéricos.
1 respuesta
Respuesta de Dante Amor
1
Te anexo las macros actualizadas para los 4 puntos
Dim colTbxs As Collection 'Collection Of Custom Textboxes
'
Private Sub CommandButton1_Click()
'Por.Dante Amor
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]
Call PasarDatos(hoja)
Else
tb_centro.SetFocus
Exit Sub
End If
Else
Call PasarDatos(hoja)
End If
End Sub
'
Sub PasarDatos(hoja)
'Por.Dante Amor
u = Sheets(hoja).Range("A" & Rows.Count).End(xlUp).Row + 1
Sheets(hoja).Cells(u, "A") = tb_centro
Sheets(hoja).Cells(u, "B") = tb_alta
Sheets(hoja).Cells(u, "C") = TextBox1
Sheets(hoja).Cells(u, "D") = tb_nombre
Sheets(hoja).Cells(u, "E") = tb_apellido1
Sheets(hoja).Cells(u, "F") = tb_apellido2
Sheets(hoja).Cells(u, "G") = tb_edad
Sheets(hoja).Cells(u, "H") = tb_nif
Sheets(hoja).Cells(u, "I") = tb_telefono
Sheets(hoja).Cells(u, "J") = tb_email
Sheets(hoja).Cells(u, "K") = tb_facebook
For Each ctrl In Me.Controls
If TypeName(ctrl) = "TextBox" Then ctrl.Value = ""
Next
MsgBox "Cliente Registrado"
End Sub
'Por.Dante Amor
Private Sub tb_telefono_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
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
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_centro", "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 SubEsto va en la Clase1
Public WithEvents tbxCustom1 As MSForms.TextBox 'Custom Textbox Private Sub tbxCustom1_Change() tbxCustom1.Text = UCase(tbxCustom1.Text) End Sub Private Sub Class_Terminate() Set tbxCustom1 = Nothing End Sub
' : ) 'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias ' : )
Gracias!, funciona bien salvo un pequeño detalle, después ingresar el primer cliente, una vez se borra el formulario ya no aparece la fecha actualizada
Antes de esta línea:
MsgBox "Cliente Registrado"
Agrega esta línea
tb_alta = Date
' : ) 'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias ' : )
