Auto generar código alfanumérico y mostrarlo en un TextBox
Tengo un userform para cargar datos a una BD llamada "Inventario" en el hay un TextBox1 donde debo colocar un código alfanumérico de la forma "FEC-000001" quisiera ver si hay alguna forma de cargar automáticamente el código al TextBox sumándole uno al ultimo existente cada vez que abra el userform y/o cargue la información a la BD con el CommandButton1. Anexo código del userform.
P.D. La base de datos ya tiene información
Private Sub CommandButton1_Click()
Dim c As Range
With Worksheets("Inventario").Range("a2:a1000000")
Set c = .Find(TextBox1, , LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then
Worksheets("inventario").Visible = True
Worksheets("inventario").Select
c.Select
MsgBox "Clave : " & TextBox1 & " Ya Existe"
TextBox1 = Empty
TextBox2 = Empty
TextBox3 = Empty
TextBox4 = Empty
TextBox5 = Empty
TextBox6 = Empty
ComboBox1 = ""
TextBox1.SetFocus
Exit Sub
Else
If TextBox1 = "" Then
MsgBox "Ingrese Clave"
TextBox1.SetFocus
Exit Sub
End If
If TextBox2 = "" Then
MsgBox "Ingrese Articulo"
TextBox2.SetFocus
Exit Sub
End If
If TextBox4 = "" Then
MsgBox "Ingrese Marca"
TextBox4.SetFocus
Exit Sub
End If
If ComboBox1 = "" Then
MsgBox "Ingrese Unidad"
ComboBox1.SetFocus
Exit Sub
End If
If TextBox5 = "" Then
MsgBox "Ingrese Procedencia"
TextBox5.SetFocus
Exit Sub
End If
If TextBox3 = "" Then
MsgBox "Ingrese Existencia Inicial"
TextBox3.SetFocus
Exit Sub
End If
If TextBox6 = "" Then
MsgBox "Ingrese Comentario"
TextBox6.SetFocus
Exit Sub
End If
End If
End With
strTitulo = "Ferrociclables, S.A. de C.V."
Continuar = MsgBox("Dar de alta los datos?", vbYesNo + vbExclamation, strTitulo)
If Continuar = vbNo Then Exit Sub
libre = ActiveSheet.Range("A65536").End(xlUp).Row + 1
Worksheets("Inventario").Cells(libre, 1).Value = TextBox1
Worksheets("Inventario").Cells(libre, 2).Value = TextBox2
Worksheets("Inventario").Cells(libre, 3).Value = TextBox4
Worksheets("Inventario").Cells(libre, 4).Value = ComboBox1
Worksheets("Inventario").Cells(libre, 5).Value = TextBox5
Worksheets("Inventario").Cells(libre, 6).Value = Val(TextBox3)
Worksheets("Inventario").Cells(libre, 9).Value = "=RC[-3]+RC[-2]-RC[-1]"
Worksheets("Inventario").Cells(libre, 10).Value = TextBox6
If TextBox3 = 0 Then
End If
TextBox1 = Empty 'textbox1, dejar en blanco
TextBox2 = Empty 'etc
TextBox4 = Empty
ComboBox1 = Empty
TextBox5 = Empty
TextBox3 = Empty
TextBox6 = Empty
MsgBox "Datos guardados" 'mostrar el mensaje "Datos guardados"
MsgBox "Alta exitosa.", vbInformation, strTitulo
End Sub
Private Sub CommandButton2_Click()
sino = MsgBox("Estás seguro de cerrar alta de articulos?", vbYesNo, "CONFIRMA")
If sino <> vbYes Then Exit Sub
Cancel = True
Altas.Hide
Menu.Show
End Sub
Private Sub TextBox1_Change()
Set rango = Selection
For Each cell In rango
TextBox1.Value = UCase(TextBox1.Value)
Next
End Sub
Private Sub TextBox2_Change()
Set rango = Selection
For Each cell In rango
TextBox2.Value = UCase(TextBox2.Value)
Next
End Sub
Private Sub TextBox4_Change()
Set rango = Selection
For Each cell In rango
TextBox4.Value = UCase(TextBox4.Value)
Next
End Sub
Private Sub TextBox5_Change()
Set rango = Selection
For Each cell In rango
TextBox5.Value = UCase(TextBox5.Value)
Next
End Sub
Private Sub TextBox6_Change()
Set rango = Selection
For Each cell In rango
TextBox6.Value = UCase(TextBox6.Value)
Next
End Sub
Private Sub UserForm_Activate()
ComboBox1.Clear
TextBox1 = Empty
TextBox2 = Empty
TextBox3 = Empty
TextBox4 = Empty
TextBox5 = Empty
TextBox6 = Empty
TextBox1. SetFocus
ComboBox1. AddItem "PIEZA"
ComboBox1. AddItem "KILOS"
ComboBox1. AddItem "LATA"
ComboBox1. AddItem "PAQUETE"
ComboBox1. AddItem "KIT"
ComboBox1. AddItem "CAJA"
ComboBox1. AddItem "BOTE"
ComboBox1. AddItem "PAR"
ComboBox1. AddItem "METROS"
ComboBox1. AddItem "ROLLO"
ComboBox1. AddItem "JUEGO"
ComboBox1. AddItem "BOLSA"
End Sub
'Evita Cerrar La Ventana
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = 0 Then
MsgBox "Use el botón Cerrar del formulario", vbInformation, " Botón No Disponible "
Cancel = 1
CloseMode = 1
End If
End Sub
2 Respuestas
Respuesta de James Bond
2
Respuesta de Programar Excel
1


y este fue el cambio, como ves no hay textbox1.text