LIstado de compras y Actualizar stock en un command_button (vba excel)

Gracias al compañero Sebas Torres, conseguí registrar la compra en la hoja de "ENTRADAS".

Ahora necesitaría, a la vez de registrar la compra, mediante el botón "ACEPTAR", que actualize el stock en la hoja "ARTICULOS".

A ver si algun compañero puede ayudarme

Dejo el codigo del "frm_compras"

Private Sub cmb_aceptar_Click()
'
Set h1 = Sheets("ENTRADAS")
'
For Fila = 0 To ListBox1.ListCount - 1
    Ufila = Range("A" & Rows.Count).End(xlUp).Row + 1
    h1.Cells(Ufila, 1) = Me.lb_entradas.Caption
    h1.Cells(Ufila, 2) = "COMPRA"
    h1.Cells(Ufila, 3) = Me.lb_fecha.Caption
    h1.Cells(Ufila, 4) = Me.lb_compras.Caption
    h1.Cells(Ufila, 5) = Me.cbx_pago.Value
    h1.Cells(Ufila, 6) = Me.txt_prov_nombre.Value
    h1.Cells(Ufila, 9) = ListBox1.List(Fila, 0)
    h1.Cells(Ufila, 8) = ListBox1.List(Fila, 1)
    h1.Cells(Ufila, 10) = ListBox1.List(Fila, 2)
    h1.Cells(Ufila, 11) = ListBox1.List(Fila, 3)
    h1.Cells(Ufila, 13) = ListBox1.List(Fila, 4)
    h1.Cells(Ufila, 14) = Me.txt_total.Value
   MsgBox "COMPRA exitosa", vbInformation, "fjpg GAMES"
    Unload Me
Next
End Sub
Private Sub cmb_cancelar_Click()
End Sub
Private Sub lb_articulo_anadir_Click()
frm_compras_articulo.Show
End Sub
Private Sub lb_articulo_borrar_Click()
'Por.Dante Amor
    If ListBox1.ListIndex = -1 Then
        MsgBox "Selecciona un ARTÍCULO", vbInformation, "fjpg GAMES"
        Exit Sub
    End If
    '
    If (MsgBox("¿Quieres borrar el ARTÍCULO seleccionado?", vbCritical + vbYesNo, "fjpg GAMES") = vbYes) Then
        ListBox1.RemoveItem ListBox1.ListIndex
    For i = 0 To ListBox1.ListCount - 1
        w_txt_total = w_txt_total + CDbl(ListBox1.List(i, 4))
    Next
    txt_total = w_txt_total
    MsgBox "ARTÍCULO borrado", vbInformation, "fjpg GAMES"
    Else
    Cancel = 1
    End If
End Sub
Private Sub lb_proveedor_borrar_Click()
    If (MsgBox("¿Quieres borrar el proveedor?", vbCritical + vbYesNo, "fjpg GAMES") = vbYes) Then
        txt_prov_codigo.Text = ""
        txt_prov_nombre.Text = ""
        txt_direccion.Text = ""
        txt_telf.Text = ""
        txt_correo.Text = ""
        txt_www.Text = ""
        txt_contacto.Text = ""
    Else
    Cancel = 1
    End If
End Sub
Private Sub lb_proveedor_anadir_Click()
frm_compras_proveedor.Show
End Sub
Private Sub txt_prov_codigo_Change()
If txt_prov_codigo.Value = "" Then
        lb_proveedor_anadir.Enabled = True
        lb_proveedor_borrar.Enabled = False
        lb_articulo_anadir.Enabled = False
        lb_articulo_borrar.Enabled = False
    Else
        lb_proveedor_anadir.Enabled = False
        lb_proveedor_borrar.Enabled = True
        lb_articulo_anadir.Enabled = True
        lb_articulo_borrar.Enabled = True
        Exit Sub
    End If
End Sub
Private Sub txt_total_Change()
txt_total = Format(txt_total, "currency")
End Sub
Private Sub UserForm_Activate()
txt_total = Format(txt_total, "currency")
End Sub
Private Sub UserForm_Initialize()
'Sheets("ENTRADAS").Select
lb_fecha.Caption = Format(Date, "dd/mm/yyyy")
Hoja7.Range("D3").Value = Hoja7.Range("D3").Value + 1
lb_entradas.Caption = Hoja7.Range("D3").Value
Me.lb_entradas.Caption = Format(Me.lb_entradas, "0000")
Hoja7.Range("f3").Value = Hoja7.Range("f3").Value + 1
lb_compras.Caption = Hoja7.Range("f3").Value
Me.lb_compras.Caption = Format(Me.lb_compras, "0000")
cbx_pago.SetFocus
lb_proveedor_anadir.Enabled = True
lb_proveedor_borrar.Enabled = False
lb_articulo_anadir.Enabled = False
lb_articulo_borrar.Enabled = False
cbx_pago.AddItem "EFECTIVO"
cbx_pago.AddItem "PAYPAL"
cbx_pago.AddItem "TARJETA"
cbx_pago.AddItem "TRANSFERENCIA"
End Sub

1 respuesta

Respuesta
1

[Hola envíame tu archivo para revisarlo [email protected]

Hola Adriel. Archivo enviado!! Gracias!!

[Hola 

Te paso la macro actualizada


Recuerda cambiar la valoración a excelente saludos!

Private Sub cmb_aceptar_Click()
'
'Act. Adriel Ortiz Mangia
'
Set h1 = Sheets("ENTRADAS")
Set h2 = Sheets("ARTICULOS")
'
For Fila = 0 To ListBox1.ListCount - 1
    Ufila = Range("A" & Rows.Count).End(xlUp).Row + 1
    h1.Cells(Ufila, 1) = Me.lb_entradas.Caption
    h1.Cells(Ufila, 2) = "COMPRA"
    h1.Cells(Ufila, 3) = Me.lb_fecha.Caption
    h1.Cells(Ufila, 4) = Me.lb_compras.Caption
    h1.Cells(Ufila, 5) = Me.cbx_pago.Value
    h1.Cells(Ufila, 6) = Me.txt_prov_nombre.Value
    '
    h1.Cells(Ufila, 9) = ListBox1.List(Fila, 0)
    h1.Cells(Ufila, 8) = ListBox1.List(Fila, 1)
    h1.Cells(Ufila, 10) = ListBox1.List(Fila, 2)
    h1.Cells(Ufila, 11) = ListBox1.List(Fila, 3)
    h1.Cells(Ufila, 13) = ListBox1.List(Fila, 4)
    h1.Cells(Ufila, 14) = Me.txt_total.Value
    '
    dato = ListBox1.List(Fila, 1)
    '
    Set r = h2.Columns("A")
    Set b = r.Find(Val(dato), lookat:=xlWhole)
    If Not b Is Nothing Then
        h2.Cells(b.Row, "F") = h2.Cells(b.Row, "F") + ListBox1.List(Fila, 2)
    End If
    '
    MsgBox "COMPRA exitosa", vbInformation, "fjpg GAMES"
    Unload Me
Next
End Sub

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas