Guardar datos de formulario vba excel repetidas veces según se necesite
Tengo un sistema de inventarios en el cual mediante un formulario en vba excel, doy de alta a los bienes que ingresan. Actualmente todo esta trabajando bien pero me e visto con un detalle cuando quiero registrar por decir 20 bienes iguales tengo que registrar uno por uno. Como puedo hacer para que en algún textbox al ponerle un numero en este caso del ejemplo 20 al darle guardar me cree 20 registros iguales en mi hoja de inventarios. Espero me aya explicado. Y de igual manera que me respete el consecutivo.
Con un textbox le dice la cantidad
If TextBox = Empty Then
TextBox = "1"
End If
for x = 1 to textbox
tu macro de copiar
next X
Si no puedes pega la macro para adatarle la intrucion
Si te silve no olvide valorar para cerrar la pregunta
con este código envió los datos del formulario a la hoja. en esta parte se pega el código que me proporcionas o como quedaría?.
'Determina el final del listado de productos
For fila = 1 To 9000
If Hoja2.Cells(fila, 2) = "" Then
Final = fila
Exit For
End If
Next
If MsgBox("Son correctos los datos?" + Chr(13) + "Desea proceder?", vbOKCancel) = vbOK Then
'Envía los datos a la hoja de productos
Hoja2.Cells(Final, 1) = Me.Label13.Caption
Hoja2.Cells(Final, 2) = Me.txt_numerofac
Hoja2.Cells(Final, 3) = Me.txt_descripcion
Hoja2.Cells(Final, 4) = Me.cbo_insti
Hoja2.Cells(Final, 5) = Me.cbo_subd
Hoja2.Cells(Final, 6) = Me.cbo_centroc
Hoja2.Cells(Final, 7) = Me.TextBox1
Hoja2.Cells(Final, 8) = Me.Txt_color
Hoja2.Cells(Final, 9) = Me.txtfecha
Hoja2.Cells(Final, 10) = Me.txt_serie
Hoja2.Cells(Final, 11) = Me.txt_marca
Hoja2.Cells(Final, 12) = Me.Txtncalendario
Hoja2.Cells(Final, 13) = Me.txt_CostoUnitario
Hoja2.Cells(Final, 14) = Me.txt_PrecioVenta
Hoja2.Cells(Final, 15) = Hoja8.Range("G1")
'Envía los datos a la hoja de etiquetas
Hoja3.Cells(Final, 1) = Me.Label13.Caption
Hoja3.Cells(Final, 2) = Me.txt_numerofac
Hoja3.Cells(Final, 3) = Me.txt_descripcion
Hoja3.Cells(Final, 4) = Me.cbo_insti
Hoja3.Cells(Final, 5) = Me.cbo_subd
Hoja3.Cells(Final, 6) = Me.cbo_centroc
Hoja3.Cells(Final, 7) = Me.TextBox1
Hoja3.Cells(Final, 8) = Me.Txt_color
Hoja3.Cells(Final, 9) = Me.txtfecha
Hoja3.Cells(Final, 10) = Me.txt_serie
Hoja3.Cells(Final, 11) = Me.txt_marca
Hoja3.Cells(Final, 12) = Me.Txtncalendario
Hoja3.Cells(Final, 13) = Me.txt_CostoUnitario
Hoja3.Cells(Final, 14) = Me.txt_PrecioVenta
Hoja3.Cells(Final, 15) = Hoja8.Range("G1")
MsgBox Prompt:="Se grabó el registro con el folio " & Me.Label13.Caption, Title:="RegistroGuardado"
'Limpia los controles
Me.txt_descripcion = ""
Me.Txtncalendario = ""
Me.txt_CostoUnitario = ""
Me.txt_PrecioVenta = ""
Me.Txt_color = ""
Me.txt_serie = ""
Me.txt_marca = ""
Me.txtfecha = ""
Me.txt_numerofac = ""
Me.cbo_insti = ""
Me.cbo_subd = ""
Me.cbo_centroc = ""
Me.TextBox1 = ""
Call determinaFolioNuevo
Me.Label13.Caption = folioNuevo
Else
Exit Sub
End If
End Sub
Textbox POR seria tu textbox digas ejemplo Textbox1
If TextBox X = Empty Then
TextBox X = "1"
End If
for x = 1 to textbox X
Hoja2.Cells(Final, 1) = Me.Label13.Caption Hoja2.Cells(Final, 2) = Me.txt_numerofac Hoja2.Cells(Final, 3) = Me.txt_descripcion
......
Hoja3.Cells(Final, 12) = Me.Txtncalendario
Hoja3.Cells(Final, 13) = Me.txt_CostoUnitario
Hoja3.Cells(Final, 14) = Me.txt_PrecioVenta
Hoja3.Cells(Final, 15) = Hoja8.Range("G1")next X
MsgBox Prompt:="Se grabó el registro con el folio " & Me.Label13.Caption, Title:="RegistroGuardado" 'Limpia los controles Me.txt_descripcion = "" Me.Txtncalendario = ""
asi debe quedar recuerad deberar agregar un textbox X para sea el indicador de la cantidad
Recuardad valorar para cerrar la pregunta
No me funciona que estaré haciendo mal

te dejo todo el codigo del boton guardar para ver si lo puedes agregar
Private Sub CommandButton1_Click()
Dim fila As Integer
Dim Final As Integer
Dim Registro As Integer
Dim Titulo As String
Titulo = "Gestor de Inventarios"
'Validando los controles sin datos
If Me.txt_numerofac = "" Then
Me.txt_numerofac.BackColor = &HC0C0FF
MsgBox "Debe ingresar una numero de factura", , Titulo
Me.txt_numerofac.SetFocus
Exit Sub
ElseIf Me.txt_descripcion = "" Then
Me.txt_descripcion.BackColor = &HC0C0FF
MsgBox "Debe ingresar una descripción", , Titulo
Me.txt_descripcion.SetFocus
Exit Sub
ElseIf Me.Txt_color = 0 Then
Me.Txt_color.BackColor = &HC0C0FF
MsgBox "Debe ingresar el Color", , Titulo
Me.Txt_color.SetFocus
Exit Sub
ElseIf Me.txt_serie = 0 Then
Me.txt_serie.BackColor = &HC0C0FF
MsgBox "Debe ingresar un numero de serie", , Titulo
Me.txt_serie.SetFocus
Exit Sub
ElseIf Me.txt_marca = 0 Then
Me.txt_marca.BackColor = &HC0C0FF
MsgBox "Debe ingresar un numero de marca", , Titulo
Me.txt_marca.SetFocus
Exit Sub
ElseIf Me.txt_CostoUnitario = 0 Then
Me.txt_CostoUnitario.BackColor = &HC0C0FF
MsgBox "Debe ingresar un precio", , Titulo
Me.txt_CostoUnitario.SetFocus
Exit Sub
ElseIf Me.txt_PrecioVenta = 0 Then
Me.txt_PrecioVenta.BackColor = &HC0C0FF
MsgBox "Debe ingresar un precio", , Titulo
Me.txt_PrecioVenta.SetFocus
Exit Sub
End If
'Determina el final del listado de productos
For fila = 1 To 9000
If Hoja2.Cells(fila, 2) = "" Then
Final = fila
Exit For
End If
Next
If MsgBox("Son correctos los datos?" + Chr(13) + "Desea proceder?", vbOKCancel) = vbOK Then
'Envía los datos a la hoja de productos
If TextBox X = Empty Then
TextBox X = "1"
End If
for x = 1 to textbox X
Hoja2.Cells(Final, 1) = Me.Label13.Caption
Hoja2.Cells(Final, 2) = Me.txt_numerofac
Hoja2.Cells(Final, 3) = Me.txt_descripcion
Hoja2.Cells(Final, 4) = Me.cbo_insti
Hoja2.Cells(Final, 5) = Me.cbo_subd
Hoja2.Cells(Final, 6) = Me.cbo_centroc
Hoja2.Cells(Final, 7) = Me.TextBox1
Hoja2.Cells(Final, 8) = Me.Txt_color
Hoja2.Cells(Final, 9) = Me.txtfecha
Hoja2.Cells(Final, 10) = Me.txt_serie
Hoja2.Cells(Final, 11) = Me.txt_marca
Hoja2.Cells(Final, 12) = Me.Txtncalendario
Hoja2.Cells(Final, 13) = Me.txt_CostoUnitario
Hoja2.Cells(Final, 14) = Me.txt_PrecioVenta
Hoja2.Cells(Final, 15) = Hoja8.Range("G1")
'Envía los datos a la hoja de etiquetas
Hoja3.Cells(Final, 1) = Me.Label13.Caption
Hoja3.Cells(Final, 2) = Me.txt_numerofac
Hoja3.Cells(Final, 3) = Me.txt_descripcion
Hoja3.Cells(Final, 4) = Me.cbo_insti
Hoja3.Cells(Final, 5) = Me.cbo_subd
Hoja3.Cells(Final, 6) = Me.cbo_centroc
Hoja3.Cells(Final, 7) = Me.TextBox1
Hoja3.Cells(Final, 8) = Me.Txt_color
Hoja3.Cells(Final, 9) = Me.txtfecha
Hoja3.Cells(Final, 10) = Me.txt_serie
Hoja3.Cells(Final, 11) = Me.txt_marca
Hoja3.Cells(Final, 12) = Me.Txtncalendario
Hoja3.Cells(Final, 13) = Me.txt_CostoUnitario
Hoja3.Cells(Final, 14) = Me.txt_PrecioVenta
Hoja3.Cells(Final, 15) = Hoja8.Range("G1")
MsgBox Prompt:="Se grabó el registro con el folio " & Me.Label13.Caption, Title:="RegistroGuardado"
'Limpia los controles
Me.txt_descripcion = ""
Me.Txtncalendario = ""
Me.txt_CostoUnitario = ""
Me.txt_PrecioVenta = ""
Me.Txt_color = ""
Me.txt_serie = ""
Me.txt_marca = ""
Me.txtfecha = ""
Me.txt_numerofac = ""
Me.cbo_insti = ""
Me.cbo_subd = ""
Me.cbo_centroc = ""
Me.TextBox1 = ""
Call determinaFolioNuevo
Me.Label13.Caption = folioNuevo
Else
Exit Sub
End If
End Sub
Textbox X tiene que cambiarlo por el textbox nuevo que agregegaste al formulario o al menos que le pongas nombre Cómo los demás textbox
Textbox1 por decir que sea ese o
Textbox2 no cual seria en tu caso
Y después de
Me. Label13.Caption ...
Tiene pones estos
Next X
Si no puedes este es mi correo [email protected] envíame el archivo y lo reviso
- Compartir respuesta