Formulario con multipagina Excel vba
Tengo un formulario en el que he creado una multipage con dos páginas: en uno se introduce los datos de una persona y en la otra página los miembros que integran esa unidad familiar. He creado un campo id para que cuando se grabe lo autonumere; sin embargo me da el siguiente error: ¿No me da el número correlativo correcto y cuando graba dos registro el siguiente que intentas grabar machaca el último?
Por más que lo estoy mirando no doy con la solución... ¿Alguien me puede ayudar?
Pongo en enlace para que se vea a que me refiero..
https://drive.google.com/open?id=1ijdqbhO0Wp9-Oodct564abedLG3fxiUP
1 Respuesta
Te anexo una propuesta.
En la pagina FICHA agregué un Label para identificar el número de ID:
Para agregar a los menores utilizaremos un listbox, de esta forma puedes agregar varios menores. No hay límite.
Tomando como base lo anterior, entonces al momento de pasar los menores a la hoja, se leerán los datos del listbox.
Funciona de la siguiente manera:
1. Capturas los datos del titular.
2. Vas la página de MENORES.
3. Capturas un menor, presionas el botón Agregar.
4. Capturar otro menor, presionas el botón Agregar.
5. Regresas a la página FICHA.
6. Presionas el botón para guardar en la hoja.
7. En la hoja "DATOS" se almacenará el titular con el ID
8. En la hoja "DATOS MENORES" se almacenará un registro con el ID por cada menor capturado.
Este es el código del userform:
Private Sub Btnregistrar_Click()
'
Dim i As Double
Dim final As Double
Dim hoy As Date
Dim validar As Boolean
'
'PRIMER APELLIDO DEL MENOR
If ALTA.TextBoxprimerapellido = Empty Then
MsgBox "DEBES INTRODUCIR EL PRIMER APELLIDO", vbInformation, "ATENCION"
Exit Sub
End If
'NOMBRE DEL MENOR
If ALTA.TextBoxnombre = Empty Then
MsgBox "DEBES INTRODUCIR EL NOMBRE", vbInformation, "ATENCION"
Exit Sub
End If
'EXPEDIENTE SIUSS
' If ALTA.TextBoxsiuss = Empty Then
' MsgBox "DEBES INTRODUCIR EL NUMERO DE EXPEDIENTE SIUSS", vbInformation, "ATENCION"
' Exit Sub
' End If
' 'ELEGIMOS CODIGO PROFESIONAL
' If ALTA.TextBoxmunicipal = Empty Then
' MsgBox "INDICA EL NUMERO DE EXPEDIENTE MUNICIPAL", vbInformation, "ATENCION"
' Exit Sub
' End If
' 'ELEGIMOS TIPO DE SITUACION
' If ALTA.ComboBoxsituacion = Empty Then
' MsgBox "INDICA EL TIPO DE SITUACION", vbInformation, "ATENCION"
' Exit Sub
' End If
' 'ELEGIMOS SITUACION ACTUAL
' If ALTA.ComboBoxactual = Empty Then
' MsgBox "INDICA LA SITUACION ACTUAL ", vbInformation, "ATENCION"
' Exit Sub
' End If
'
'Agregar a la hoja el titular
Set h1 = Sheets("DATOS")
Set h2 = Sheets("DATOS MENORES")
u1 = h1.Range("A" & Rows.Count).End(xlUp).Row + 1
h1.Cells(u1, "A").Value = Label42.Caption
h1.Cells(u1, "B").Value = TextBoxprimerapellido.Value
h1.Cells(u1, "C").Value = TextBoxsegundoapellido.Value
h1.Cells(u1, "D").Value = TextBoxnombre.Value
h1.Cells(u1, "E").Value = TextBoxnumero.Value
'
'Agrega a la hoja los menores
u2 = h2.Range("A" & Rows.Count).End(xlUp).Row + 1
For i = 0 To ListBox1.ListCount - 1
h2.Cells(u2, "A").Value = Label42.Caption
h2.Cells(u2, "B").Value = ListBox1.List(i, 1)
h2.Cells(u2, "C").Value = ListBox1.List(i, 2)
h2.Cells(u2, "D").Value = ListBox1.List(i, 3)
u2 = u2 + 1
Next
MsgBox "Registro Creado"
End Sub
'
Private Sub ComboBoxactual_Change()
If ComboBoxactual.Text = "Cerrado" Then
ComboBoxactual.BackColor = vbRed
ElseIf ComboBoxactual.Text = "Abierto" Then
ComboBoxactual.BackColor = vbGreen
End If
End Sub
'
Private Sub CommandButton1_Click()
'Agregar menores
'
MultiPage1.Value = 1
Label44.Caption = Label42.Caption
End Sub
'
Private Sub CommandButton2_Click()
MultiPage1.Value = 0
End Sub
Private Sub CommandButton3_Click()
'Agregar al listbox
'VALIDACIONES
If TextBox1.Value = "" Or _
TextBox2.Value = "" Or _
TextBox3.Value = "" Then
MsgBox "Falta información", vbCritical
TextBox1.SetFocus
Exit Sub
End If
For i = 0 To ListBox1.ListCount - 1
If ListBox1.List(i, 1) = TextBox1.Value And _
ListBox1.List(i, 2) = TextBox2.Value And _
ListBox1.List(i, 3) = TextBox3.Value Then
MsgBox "El nombre ya existe", vbExclamation
TextBox1.SetFocus
Exit Sub
End If
Next
'Se agrega el nombre al list
ListBox1.AddItem Label42
ListBox1.List(ListBox1.ListCount - 1, 1) = TextBox1.Value
ListBox1.List(ListBox1.ListCount - 1, 2) = TextBox2.Value
ListBox1.List(ListBox1.ListCount - 1, 3) = TextBox3.Value
'
TextBox1.Value = ""
TextBox2.Value = ""
TextBox3.Value = ""
End Sub
'
Private Sub TextBox1_Change()
ALTA.TextBox1.Text = UCase(ALTA.TextBox1.Text)
End Sub
Private Sub TextBox10_Change()
ALTA.TextBox10.Text = UCase(ALTA.TextBox10.Text)
End Sub
Private Sub TextBox11_Change()
ALTA.TextBox11.Text = UCase(ALTA.TextBox11.Text)
End Sub
Private Sub TextBox12_Change()
ALTA.TextBox12.Text = UCase(ALTA.TextBox12.Text)
End Sub
Private Sub TextBox2_Change()
ALTA.TextBox2.Text = UCase(ALTA.TextBox2.Text)
End Sub
Private Sub TextBox3_Change()
ALTA.TextBox3.Text = UCase(ALTA.TextBox3.Text)
End Sub
Private Sub TextBox4_Change()
ALTA.TextBox4.Text = UCase(ALTA.TextBox4.Text)
End Sub
Private Sub TextBox5_Change()
ALTA.TextBox5.Text = UCase(ALTA.TextBox5.Text)
End Sub
Private Sub TextBox6_Change()
ALTA.TextBox6.Text = UCase(ALTA.TextBox6.Text)
End Sub
Private Sub TextBox7_Change()
ALTA.TextBox7.TextBox = UCase(ALTA.TextBox7.Text)
End Sub
Private Sub TextBox8_Change()
ALTA.TextBox8.Text = UCase(ALTA.TextBox8.Text)
End Sub
Private Sub TextBox9_Change()
ALTA.TextBox9.Text = UCase(ALTA.TextBox9.Text)
End Sub
Private Sub TextBoxentidad_Change()
ALTA.TextBoxentidad.Text = UCase(ALTA.TextBoxentidad.Text)
End Sub
Private Sub TextBoxobservaciones_Change()
ALTA.TextBoxobservaciones.Text = UCase(ALTA.TextBoxobservaciones.Text)
End Sub
Private Sub TextBoxprimerapellido_Change()
ALTA.TextBoxprimerapellido.Text = UCase(ALTA.TextBoxprimerapellido.Text)
End Sub
Private Sub TextBoxsegundoapellido_Change()
ALTA.TextBoxsegundoapellido.Text = UCase(ALTA.TextBoxsegundoapellido.Text)
End Sub
Private Sub TextBoxnombre_Change()
ALTA.TextBoxnombre.Text = UCase(ALTA.TextBoxnombre.Text)
End Sub
'
Private Sub UserForm_Initialize()
Set h = Sheets("DATOS")
u = h.Range("A" & Rows.Count).End(xlUp).Row + 1
Label42 = u - 1
End Sub
'
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
On Error GoTo Fin
If CloseMode <> 1 Then Cancel = True
Fin:
End Sub
'
Private Sub Btnsalir_Click()
'CERRAMOS
' If MsgBox("¿Desea salir del formulario?", vbQuestion + vbYesNo) = vbYes Then
Unload Me
' Sheets("MENU").Activate
' End If
End SubTe anexo el archivo con los cambios en el form y con el código.
Deberás actualizar tu diseño para modifica o dar de baja registros. Con gusto te ayudo y lo vamos resolviendo.
'.[Sal u dos. Dante Amor. No olvides valorar la respuesta.
