Miguel0763

'Un favor tengo una aplicación en el cual el botón modificar, duplica los registros, es decir presenta el dato anterior y el dato corregido; el código es el siguiente:

Dim x As Byte
Dim Ncodigo As Long

Private Sub Cmbagregar_Click()
'On Error GoTo err:

If Me.Txtcantidad.Text = Empty Or Me.TxtidProducto.Text = "" Or Me.Txtprecio.Text = "" Then
MsgBox "Ingrese la cantidad", vbCritical, "Atención"
Exit Sub
End If

With Me.ListaProductos
x = .ListCount
.AddItem
.List(x, 0) = Me.TxtidProducto.Text
.List(x, 1) = Me.Txtproducto.Text
.List(x, 2) = Format(Me.Txtcantidad.Text, "0.00")
.List(x, 3) = Format(Me.Txtprecio.Text, "0.00")
.List(x, 4) = Format(Val(Me.Txtprecio.Text * Me.Txtcantidad.Text), "0.00")

.ColumnCount = 5
.ColumnWidths = "40;100;50;50;60"
End With

Call Limpiar_Textos_Productos
'err:
'MsgBox "No se encontró ningún registro para agregar en la lista", vbCritical, "Atención"

End Sub
Sub Limpiar_Textos_Productos()
Me.Txtcantidad.Text = Empty
Me.Txtprecio.Text = Empty
Me.TxtidProducto.Text = Empty
Me.Txtproducto.Text = Empty

Me.Cmbeditar.Visible = False
Me.Cmbquitar.Visible = False
Me.Cmbagregar.Visible = True

Me.Cmdproductos.SetFocus

End Sub

Private Sub Cmbbuscar_Click()
With cadena ' llama la conexion

        Set FormAsControl = Usermovimientos.Lista
        Set .FormAsObject = FormAsControl
                

.TablaConsulta ("SELECT * FROM VISTAMOVIMIENTOS WHERE RAZONSOCIAL LIKE'%" & Me.Txtbuscar.Text & "%'")
Me.Lista.ColumnWidths = "30;50;60;160;120"
                     
End With
End Sub

Private Sub Cmbcancelar_Click()
     Me.Txtcliente.Text = Empty
     Me.Txtfechadoc.Text = Empty
     Me.Txtfechareg.Text = Empty
     Me.Txtserie.Text = Empty
     Me.Txtnumero.Text = Empty
     Me.Txtidcliente.Text = Empty
     Me.Txtiddocumento.Text = Empty
     Me.Txtdocumento.Text = Empty
     Me.Txtcliente.Text = Empty
     
Me.ListaProductos.Clear
    
    Me.Cmbmodificar.Enabled = False
    Me.Cmbeliminar.Enabled = False
    Me.Cmbguardar.Enabled = True
End Sub

Private Sub Cmbcliente_Click()
Userclientes.Show

End Sub

Private Sub Cmbdocumento_Click()
Userdocumentos.Show

End Sub

Private Sub Cmbeditar_Click()
If Me.Txtcantidad.Text = Empty Or Me.TxtidProducto.Text = "" Or Me.Txtprecio.Text = "" Then

MsgBox "Ingrese la cantidad", vbCritical, "Atención"

Exit Sub
End If

With Me.ListaProductos

.List(x, 0) = Me.TxtidProducto.Text
.List(x, 1) = Me.Txtproducto.Text
.List(x, 2) = Format(Me.Txtcantidad.Text, "0.00")
.List(x, 3) = Format(Me.Txtprecio.Text, "0.00")
.List(x, 4) = Format(Val(Me.Txtprecio.Text * Me.Txtcantidad.Text), "0.00")

.ColumnCount = 5
.ColumnWidths = "40;100;50;50;60"

End With

Call Limpiar_Textos_Productos

End Sub

Private Sub Cmbeliminar_Click()
If MsgBox("Desea eliminar el registro", vbCritical + vbYesNo, "Atención") = vbYes Then

With cadena
    ' ASIGNAR EL NOMBRE DE LA TABLA EN LA CUAL SE INGRESARA LOS REGISTROS
    .Eliminar ("MOVIMIENTOS")
    '--------------------------------------------------------------------
    ' INGRESA EL ID DE LA TABLA PARA ELIMINAR EL REGISTRO
    .rst.Find "IDMOV='" & Trim(Ncodigo) & "'"
    
    '----- ELIMINA LOS REGISTROS EN LA TABLA ------
    .rst.Delete
    .rst.Requery
    
End With
Me.Cmbcancelar.Object = True
End If

End Sub

Private Sub Cmbguardar_Click()
With cadena
.Guardar ("MOVIMIENTOS")
.rst.Fields(1).Value = Me.Txtfechadoc.Text
.rst.Fields(2).Value = Me.Txtfechareg.Text
.rst.Fields(3).Value = Me.Txtserie.Text
.rst.Fields(4).Value = Me.Txtnumero.Text
.rst.Fields(5).Value = Me.Txtidcliente.Text
.rst.Fields(6).Value = Me.Txtiddocumento.Text
.rst.Update
.rst.Requery

'obtener el Id del registro movimiento
.Autonumerico ("SELECT IDMOV FROM MOVIMIENTOS")
.rst.MoveLast

Ncodigo = .rst("IDMOV").Value

End With

Call Guardar_Lista_Productos
Me.Cmbcancelar.Object = True
MsgBox "Registro guardado con éxito", vbInformation, "Atención"
End Sub
Sub Guardar_Lista_Productos()

With cadena

For I = 0 To Me.ListaProductos.ListCount - 1

.Guardar ("REGISTROPRODUCTOS")

.rst.Fields(1) = Me.ListaProductos.List(I, 0) 'CODIGO del producto
.rst.Fields(2) = Me.ListaProductos.List(I, 2) ' CANTIDAD
.rst.Fields(3) = Me.ListaProductos.List(I, 3) ' PRECIO
.rst.Fields(4) = Ncodigo

.rst.Update
.rst.Requery

Next
End With

End Sub

Private Sub Cmbmodificar_Click()
With cadena
.BarraProgreso = False
.Actualizar ("MOVIMIENTOS")
.rst.Find "IDMOV='" & Trim(Ncodigo) & "'"
.rst.Fields(1).Value = Me.Txtfechadoc.Text
.rst.Fields(2).Value = Me.Txtfechareg.Text
.rst.Fields(3).Value = Me.Txtserie.Text
.rst.Fields(4).Value = Me.Txtnumero.Text
.rst.Fields(5).Value = Me.Txtidcliente.Text
.rst.Fields(6).Value = Me.Txtiddocumento.Text
.rst.UpdateBatch
.rst.Requery

End With
Call Guardar_Lista_Productos

Me.Cmbcancelar.Enabled = True
'Call Guardar_Lista_Productos
'

'Me.Cmbcancelar.Object = True
MsgBox "Registro actualizado con éxito", vbInformation, "Atención"
    
End Sub

Private Sub Cmbquitar_Click()
On erro GoTo err:
Me.ListaProductos.RemoveItem x
Call Limpiar_Textos_Productos
Exit Sub

err:
MsgBox "No se encontró ningún registro para eliminar de la lista", vbCritical, "Atención"

End Sub

Private Sub Cmbsalir_Click()
End

End Sub

Private Sub Cmdproductos_Click()
UserBuscarProductos.Show

End Sub

Private Sub Frame2_Click()

End Sub

Private Sub Lista_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
With cadena
.BarraProgreso = True
.Buscar ("VISTAMOVIMIENTOS_BUSCAR")
.rst.Find "IDMOV='" & Trim(Me.Lista.Column(0)) & "'"
Ncodigo = .rst.Fields(0)
Me.Txtfechadoc.Text = .rst.Fields(1)
Me.Txtfechareg.Text = .rst.Fields(2)
Me.Txtserie.Text = .rst.Fields(3)
Me.Txtnumero.Text = .rst.Fields(4)
Me.Txtidcliente.Text = .rst.Fields(5)
Me.Txtiddocumento.Text = .rst.Fields(6)
Me.Txtdocumento.Text = .rst.Fields(7)
Me.Txtcliente.Text = .rst.Fields(8)

'detalle del movimiento
.BarraProgreso = False
Set FormAsControl = Usermovimientos.ListaProductos
Set .FormAsObject = FormAsControl
.TablaConsulta ("SELECT IDPRODUCTO, DETALLEPRODUCTO,CANTIDAD, TOTAL,TOTALES,IDREG FROM VISTADETALLE_MOVIMIENTO " _
        + "WHERE IDMOV=" & Me.Lista.Column(0))
    Me.ListaProductos.ColumnCount = 5
    Me.ListaProductos.ColumnWidths = "40;100;50;50;60"
    Me.Cmbmodificar.Enabled = True
    Me.Cmbeliminar.Enabled = True
    Me.Cmbguardar.Enabled = False
    Me.MultiPage1.Value = 0
     
    
End With
End Sub

Private Sub ListaProductos_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
With Me.ListaProductos
x = .ListIndex
Me.TxtidProducto.Text = .List(x, 0)
Me.Txtproducto.Text = .List(x, 1)
Me.Txtcantidad.Text = .List(x, 2)
Me.Txtprecio.Text = .List(x, 3)

End With
Me.Cmbeditar.Visible = True
Me.Cmbquitar.Visible = True
Me.Cmbagregar.Visible = False

End Sub

Private Sub MultiPage1_Change()

End Sub

Private Sub UserForm_Initialize()
Call Servidor

End Sub