Sobre userform en base de datos ordenada secuencialmente
Para Dante Amor.
En referencia al formulario que Ud. Me confeccionó requerirle una cumplimentación más.
Se trata de que en la secuencia ordenada de datos que van numerados por la columna 1 con el término referencia, cuando demos de alta por ej. Referencia 7 si todavía no existe aunque en nuestra última fila esté insertada ya la número 40 inserte la referencia 7 inmediatamente después de la 6 abriendo nueva fila aunque en la tabla figuren secuenciados... 5,7...
El formulario introducirá los datos en la última fila si secuencialmente procede después del último nº. Por ejemplo si en la última está el nº 40 y damos de alta a la nº 41 se irá a la última pero si en la última está el nº 40 y la que estamos dando de alta es la 38 buscará si existe y si no existe entonces la insertará en el lugar que le corresponde según secuencia-orden natural de los números.
¿En cuánto a la pregunta que me hacía que debía hacer la macro en el caso de que se encontrase ya una referencia dada de alta e intentásemos introducir nuevos datos con ese mismo nº de referencia? En ese caso inmediatamente ha de salir un mensaje avisando al operador de que ya existe dicho nº y por tanto se le impida introducir más datos con dicho nº.
Supongo que será añadir alguna línea más a la macro.
Me ha servido su formulario, pero si cumplimenta este añadido ya sería de matrícula de honor.
1 respuesta
H o l a:
Te anexo el código actualizado.
Private Sub CommandButton1_Click()
'Por.Dante Amor
If TextBox1 = "" Or Not IsNumeric(TextBox1) Or TextBox1 = 0 Then
MsgBox "Captura una referencia válida", vbCritical, "BASE DE DATOS"
TextBox1.SetFocus
Exit Sub
End If
If Not IsDate(TextBox5) Then
MsgBox "Captura una fecha válida", vbCritical, "BASE DE DATOS"
TextBox5.SetFocus
Exit Sub
End If
Set b = Columns("A").Find(CDbl(TextBox1), lookat:=xlWhole)
If Not b Is Nothing Then
MsgBox "La referencia ya existe. Caputra una referencia válida", vbCritical, "BASE DE DATOS"
TextBox1.SetFocus
Exit Sub
End If
'
If TextBox3 = "" Then txt3 = 0 Else txt3 = CDbl(TextBox3)
If TextBox4 = "" Then txt4 = 0 Else txt4 = CDbl(TextBox4)
If TextBox6 = "" Then txt6 = 0 Else txt6 = CDbl(TextBox6)
'
For i = 2 To Rows.Count
If Cells(i, "A") = "" Then
fila = i
insf = False
Exit For
End If
If Cells(i, "A") > CDbl(TextBox1) Then
fila = i
insf = True
Exit For
End If
Next
'
If insf Then
Rows(fila).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow
End If
Cells(fila, "A") = CDbl(TextBox1)
Cells(fila, "B") = TextBox2
Cells(fila, "C") = CDbl(txt3)
Cells(fila, "E") = CDbl(txt4)
Cells(fila, "N") = CDate(TextBox5)
Cells(fila, "O") = CDbl(txt6)
TextBox1 = ""
TextBox2 = ""
TextBox3 = ""
TextBox4 = ""
TextBox5 = ""
TextBox6 = ""
MsgBox "Datos guardados"
End SubSal u dos
Me pasa una cosa. De normal yo tengo la hoja protegida para evitar que puedan alterar celdas con fórmulas. Entonces cuando ejecuto el formulario y le doy a enter al estar la hoja protegida me da error, por lo que para que funcione con normalidad el formulario he de desproteger la hoja. ¿Podrías decirme que he de añadir al código para que desproteja cuando envie datos a celdas y vuelva a proteger de nuevo una vez introducidos?
Quedaría así, cambia "abc" por el password que desees
Private Sub CommandButton1_Click()
'Por.Dante Amor
If TextBox1 = "" Or Not IsNumeric(TextBox1) Or TextBox1 = 0 Then
MsgBox "Captura una referencia válida", vbCritical, "BASE DE DATOS"
TextBox1.SetFocus
Exit Sub
End If
If Not IsDate(TextBox5) Then
MsgBox "Captura una fecha válida", vbCritical, "BASE DE DATOS"
TextBox5.SetFocus
Exit Sub
End If
Set b = Columns("A").Find(CDbl(TextBox1), lookat:=xlWhole)
If Not b Is Nothing Then
MsgBox "La referencia ya existe. Caputra una referencia válida", vbCritical, "BASE DE DATOS"
TextBox1.SetFocus
Exit Sub
End If
'
If TextBox3 = "" Then txt3 = 0 Else txt3 = CDbl(TextBox3)
If TextBox4 = "" Then txt4 = 0 Else txt4 = CDbl(TextBox4)
If TextBox6 = "" Then txt6 = 0 Else txt6 = CDbl(TextBox6)
'
For i = 2 To Rows.Count
If Cells(i, "A") = "" Then
fila = i
insf = False
Exit For
End If
If Cells(i, "A") > CDbl(TextBox1) Then
fila = i
insf = True
Exit For
End If
Next
'
activesheet.unprotect "abc"
If insf Then
Rows(fila).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow
End If
Cells(fila, "A") = CDbl(TextBox1)
Cells(fila, "B") = TextBox2
Cells(fila, "C") = CDbl(txt3)
Cells(fila, "E") = CDbl(txt4)
Cells(fila, "N") = CDate(TextBox5)
Cells(fila, "O") = CDbl(txt6)
TextBox1 = ""
TextBox2 = ""
TextBox3 = ""
TextBox4 = ""
TextBox5 = ""
TextBox6 = ""
activesheet.protect "abc"
MsgBox "Datos guardados"
End Subsal u dos
