CONTROL DE INVENTARIOS FIFO EN ACCESS VBA | ENT-9

Hazte fan!! Síguenos!!












En esta publicación se comparten los códigos VBA en Access, para nuestro Sistema de Inventarios y Compras en Access.

Tambien puedes adquirir el Sistema de Inventarios y Compras para este video tutorial para mejor aprendizaje por solo $4.50 dolares


Se explica el funcionamiento lógico del Sistema enfocado a la entrega 9, se aprecia claramente el funcionamiento del control de inventarios aplicando el sistema FIFO o PEPS como también se le conoce.


VER VÍDEO EXPLICACIÓN




Aquí les comparto los códigos, les recomiendo primero descargar el diseño de esta entrega en la anterior publicación de este laboratorio.


CÓDIGO DE MODULO DE INVENTARIOS

Option Compare Database
Option Explicit
Public MSGListado As String

'Funcion Principal de Inventarios
'Modificar el disponible de Inventario de Productos
Public Function ModificarInventarios(idInvHist As Integer) As Boolean
On Error GoTo Err:
DoCmd.SetWarnings False

Dim idProd As Integer
Dim tipoMov As String
Dim cantMov As Integer
Dim cantActual As Double
Dim cantNueva As Double
Dim idLoc As Integer

idProd = Nz(DLookup("ID_PRODUCTO", "HISTORIA_MOV", "ID_INV_HIST=" & idInvHist), 0)
tipoMov = Nz(DLookup("TIPO_MOV", "HISTORIA_MOV", "ID_INV_HIST=" & idInvHist), "")
cantMov = Nz(DLookup("CANT_MOV", "HISTORIA_MOV", "ID_INV_HIST=" & idInvHist), 0)

cantActual = Nz(DLookup("CANT_DISP", "INVENTARIOS", "ID_PRODUCTO=" & idProd), 0)


Select Case tipoMov
    Case Is = "ENTRADA"
        'Modificar Capacidad UTILIZADA de LOCACIONES de Inventario
        idLoc = Forms![MOVIMIENTOS DE INVENTARIOS]!ComboBoxID_LOC
        If ModCapUtilizadaLocaciones(idLoc, cantMov, tipoMov) = False Then
            MsgBox "La Capacidad disponible en esta locacion es menor a la cantidad que desea Mover. Elija otra Locacion", vbCritical + vbOKOnly
            ModificarInventarios = False
            Exit Function
        End If
        cantNueva = cantActual + cantMov
    Case Is = "SALIDA"
        cantNueva = cantActual - cantMov
        Call DescontarInventarios(idProd, cantMov)
End Select

'Acualizar inventario DISPONIBLE
DoCmd.RunSQL "UPDATE INVENTARIOS SET CANT_DISP=" & cantNueva & " WHERE ID_PRODUCTO=" & idProd & ";"
ModificarInventarios = True

Exit Function
Err:
    MsgBox "Un error ha ocurrido: " & Err.Description, vbCritical + vbOKOnly
End Function

'Modificar la Capacidad Utilizada de LOCACIONES
Public Function ModCapUtilizadaLocaciones(idLocacion As Integer, CantModificar As Integer, tipoMovimiento As String) As Boolean
On Error GoTo Err:

DoCmd.SetWarnings False
Dim capacidadTotal As Integer           'Capacidad total del Contenedor
Dim actualCapUtiDisponible As Integer   'Actual Capacidad Utilizada Disponible
Dim CapUtilizada As Integer             'Nueva Capacidad Utilizada Disponible
Dim nuevaCapUtilizada As Integer        'Nueva Capacidad Utilizada Disponible

    capacidadTotal = Nz(DLookup("CAPACIDAD", "LOCACIONES", "ID_LOC=" & idLocacion), 0)
    actualCapUtiDisponible = capacidadTotal - Nz(DLookup("CAP_UTILIZADA", "LOCACIONES", "ID_LOC=" & idLocacion), 0)
    CapUtilizada = Nz(DLookup("CAP_UTILIZADA", "LOCACIONES", "ID_LOC=" & idLocacion), 0)
    
    Select Case tipoMovimiento
        Case Is = "ENTRADA"
            If CantModificar > actualCapUtiDisponible Then
                    ModCapUtilizadaLocaciones = False
                    Exit Function
            End If
            
            nuevaCapUtilizada = CapUtilizada + CantModificar
            
            DoCmd.RunSQL "UPDATE LOCACIONES SET CAP_UTILIZADA=" & nuevaCapUtilizada & " WHERE ID_LOC=" & idLocacion & ";"
            
            ModCapUtilizadaLocaciones = True
        Case Is = "SALIDA"
            
            nuevaCapUtilizada = CapUtilizada - CantModificar

            DoCmd.RunSQL "UPDATE LOCACIONES SET CAP_UTILIZADA=" & nuevaCapUtilizada & " WHERE ID_LOC=" & idLocacion & ";"

            ModCapUtilizadaLocaciones = True
    End Select

Exit Function
Err:
    MsgBox "Un error ha ocurrido: " & Err.Description, vbCritical + vbOKOnly
End Function

Public Function DescontarInventarios(idProd As Integer, cantDescontar As Integer) As Boolean
On Error GoTo Err:

Dim rst As DAO.Recordset
Dim sqlStr As String
Dim cantLocacion As Integer
Dim listadoDeLocacionesADescontar(100) As String
'Dim msgListado As String
Dim cont As Integer

cont = 0

sqlStr = "SELECT * FROM [HISTORIA_MOV] HM  WHERE HM.ID_PRODUCTO=" & idProd & " AND HM.TIPO_MOV='ENTRADA'" & " ; "
Set rst = CurrentDb.OpenRecordset(sqlStr)

If rst.BOF And rst.EOF Then
        DescontarInventarios = False 'No encontro ningun registro
        GoTo CerrarConexion
    Else
        Do While Not rst.EOF
            cantLocacion = rst!CANT_MOV
            
            '========================================================
            'Se ejecuta si PARCIAL ES VERDADERO
            '========================================================
            If rst!PARCIAL = True Then
                'Cantidad a descontar es menor a locacion
                If cantDescontar < rst!CANT_PARCIAL Then
                    rst.Edit
                        rst!CANT_PARCIAL = rst!CANT_PARCIAL - cantDescontar
                        listadoDeLocacionesADescontar(cont) = "Locacion: " & DLookup("COD_LOC", "LOCACIONES", "ID_LOC=" & rst!ID_LOC) & ", Cantidad: " & cantDescontar & ", Lote: " & rst!LOTE
                        Call ModCapUtilizadaLocaciones(rst!ID_LOC, cantDescontar, "SALIDA")
                    rst.Update
                    GoTo CerrarConexion
                End If
                'Cantidad a descontar es igual a locacion
                If cantDescontar = rst!CANT_PARCIAL Then
                    rst.Edit
                        rst!PARCIAL = False
                        listadoDeLocacionesADescontar(cont) = "Locacion: " & DLookup("COD_LOC", "LOCACIONES", "ID_LOC=" & rst!ID_LOC) & ", Cantidad: " & cantDescontar & ", Lote: " & rst!LOTE
                        Call ModCapUtilizadaLocaciones(rst!ID_LOC, cantDescontar, "SALIDA")
                        rst!CANT_PARCIAL = 0
                    rst.Update
                    GoTo CerrarConexion
                End If
                'Cantidad a descontar es mayor a locacion
                If cantDescontar > rst!CANT_PARCIAL Then
                    rst.Edit
                        'Call ModCapUtilizadaLocaciones(rst!ID_LOC, cantDescontar, "SALIDA")
                        rst!PARCIAL = False
                        Call ModCapUtilizadaLocaciones(rst!ID_LOC, rst!CANT_PARCIAL, "SALIDA")
                        listadoDeLocacionesADescontar(cont) = "Locacion: " & DLookup("COD_LOC", "LOCACIONES", "ID_LOC=" & rst!ID_LOC) & ", Cantidad: " & rst!CANT_PARCIAL & ", Lote: " & rst!LOTE
                        cantDescontar = cantDescontar - rst!CANT_PARCIAL
                        rst!CANT_PARCIAL = 0
                    rst.Update
                End If
            End If
            
            '========================================================
            'Se ejecuta si DISPONIBLE ES VERDADERO
            '========================================================
            If rst!DISPONIBLE = True Then
                'Cantidad a descontar es menor a locacion
                If cantDescontar < cantLocacion Then
                    rst.Edit
                        rst!DISPONIBLE = False
                        rst!PARCIAL = True
                        rst!CANT_PARCIAL = cantLocacion - cantDescontar
                        listadoDeLocacionesADescontar(cont) = "Locacion: " & DLookup("COD_LOC", "LOCACIONES", "ID_LOC=" & rst!ID_LOC) & ", Cantidad: " & cantDescontar & ", Lote: " & rst!LOTE
                        Call ModCapUtilizadaLocaciones(rst!ID_LOC, cantDescontar, "SALIDA")
                    rst.Update
                    GoTo CerrarConexion
                End If
                'Cantidad a descontar es igual a locacion
                If cantDescontar = cantLocacion Then
                    rst.Edit
                        rst!DISPONIBLE = False
                        listadoDeLocacionesADescontar(cont) = "Locacion: " & DLookup("COD_LOC", "LOCACIONES", "ID_LOC=" & rst!ID_LOC) & ", Cantidad: " & cantDescontar & ", Lote: " & rst!LOTE
                        Call ModCapUtilizadaLocaciones(rst!ID_LOC, cantDescontar, "SALIDA")
                    rst.Update
                    GoTo CerrarConexion
                End If
                'Cantidad a descontar es mayor a locacion
                If cantDescontar > cantLocacion Then
                    rst.Edit
                        rst!DISPONIBLE = False
                        Call ModCapUtilizadaLocaciones(rst!ID_LOC, cantLocacion, "SALIDA")
                        listadoDeLocacionesADescontar(cont) = "Locacion: " & DLookup("COD_LOC", "LOCACIONES", "ID_LOC=" & rst!ID_LOC) & ", Cantidad: " & cantLocacion & ", Lote: " & rst!LOTE
                        cantDescontar = cantDescontar - cantLocacion
                    rst.Update
                End If
            End If
            '--------------------------------------------------------
            
            rst.MoveNext
            cont = cont + 1
        Loop
End If

CerrarConexion:
MSGListado = ""
Dim i As Integer
For i = 0 To cont
    MSGListado = MSGListado & listadoDeLocacionesADescontar(i) & vbCrLf
Next i

rst.Close
Set rst = Nothing

Exit Function
Err:
    MsgBox "Un error ha ocurrido: " & Err.Description, vbCritical + vbOKOnly
End Function



Public Function ObtenerListado() As String
    ObtenerListado = MSGListado
End Function




CÓDIGO DE MODULO DE VALIDACIONCAMPOS

Option Compare Database
Option Explicit

Public Function CampoVacio(NomForm As Form, Cancel As Integer) As Boolean
' Codigo para impedir una accion . . . !!
' si existiese  algun campo vacio
On Error GoTo Err_CampoVacio_Click
Dim campo As Control 'Variable tipo control
For Each campo In NomForm 'Abro un Bucle
 ' Inpido los tipos de campo que deseo recorrer para analizar
    If TypeOf campo Is TextBox Or TypeOf campo Is ComboBox Or TypeOf campo Is ListBox Then
        If Left(campo.Name, 2) <> "ID" And campo.Properties("Enabled") = True Then
            If Not IsNull(campo) Then 'La condicion
                    campo.BackColor = vbWhite 'se establece fondo blanco
                    'De no haber campo nulo dejo correr el codigo
                Else
                    campo.BackColor = vbYellow 'Le pongo color para diferenciarlo
                    campo.SetFocus
                    MsgBox "Para realizar esta Accion " & vbCrLf & _
                    "se requiere un valor para " & campo.Name _
                    , vbExclamation, "Campo Vacio"
                    Cancel = True
                    End
                    Exit Function
                    'Si lo encuentro, detengo el codigo, aviso con un Msgbox
                    'y Situo el setfocus al campo vacio
            End If
        End If
    End If
Next campo
'Si llegamos aqui es que no consigo campos nulos
'Y ejecuto el comando (Puedes colocar cualquiera)
'Abrir form, consultas, exportar a pdf, etc....
CampoVacio = False
Exit_CampoVacio_Click: 'Tratamiento de errores
    Exit Function
Err_CampoVacio_Click:
    MsgBox Err.Description
    Resume Exit_CampoVacio_Click
        
End Function


CÓDIGOS DE FORMULARIO MOVIMIENTOS DE INVENTARIOS

Option Compare Database
Option Explicit

Private Sub ComandoGUARDAR_Y_SALIR_Click()
On Error GoTo Err:
Dim invDisponible As Integer
    
    'Verificar Campos Vacios en Formulario
    If CampoVacio(Me.Form, 0) = False Then
        
        'Asignar Valores a Controles
        Me.ID_PRODUCTO.Value = DLookup("ID_PRODUCTO", "PRODUCTOS", "ID_PRODUCTO=" & Forms![INVENTARIOS DE PRODUCTO]!ComboBUSCAR_PRODUCTO)
        Me.FECHA_MOV.Value = Date
        Me.HORA_MOV.Value = Time
        
        '========================================================
        'Se ejecuta si el movimiento es una ENTRADA DE INVENTARIO
        '========================================================
        If Me.TIPO_MOV.Value = "ENTRADA" Then
            'Guardar Registro
            DoCmd.RunCommand acCmdSaveRecord
            
            'Refrescar Formulario Principal
            Forms![INVENTARIOS DE PRODUCTO].Refresh
            Forms![INVENTARIOS DE PRODUCTO]![Subformulario RANGOS_INV_PRODUCTO].Requery
            
            'Modificar Inventarios con Ultimo Movimiento registrado, pasamos como argumento el ID del movimiento generado
            If ModificarInventarios(Me.ID_INV_HIST.Value) = True Then
                'Salir
                DoCmd.Close
                Exit Sub
            End If
        End If
        
        '=======================================================
        'Se ejecuta si el movimiento es una SALIDA DE INVENTARIO
        '=======================================================
        If Me.TIPO_MOV.Value = "SALIDA" Then
            
            'Verificar si hay suficiente Inventario
            invDisponible = Nz(DLookup("CANT_DISP", "INVENTARIOS", "ID_PRODUCTO=" & Me.ID_PRODUCTO.Value), 0)
            If Me.CANT_MOV.Value > invDisponible Then
                 MsgBox "No hay suficiente inventario de este producto para dar SALIDA. Elija una Cantidad menor", vbCritical + vbOKOnly
                 Exit Sub
            End If
            
             'Guardar Registro
            Me.DISPONIBLE.Value = False
            DoCmd.RunCommand acCmdSaveRecord
            
            'Refrescar Formulario Principal
            Forms![INVENTARIOS DE PRODUCTO].Refresh
            Forms![INVENTARIOS DE PRODUCTO]![Subformulario RANGOS_INV_PRODUCTO].Requery
            
            'Modificar Inventarios con Ultimo Movimiento registrado, pasamos como argumento el ID del movimiento generado
            If ModificarInventarios(Me.ID_INV_HIST.Value) = True Then
                'Salir
                DoCmd.Close
            End If
            
            'Abrir Reporte de listado de partes
             DoCmd.OpenReport "LISTADO", acViewPreview
        End If
        '---------------------------------------------------------
        
    End If

Exit Sub
Err:
    MsgBox "Un error ha ocurrido: " & Err.Description, vbCritical + vbOKOnly
End Sub

Private Sub ComboBoxID_LOC_AfterUpdate()
On Error GoTo Err:

    'Mostrar Capacidad de Locacion
    Dim capacidad As Integer
    Dim utilizada As Integer
    
    Dim tipoMov As String
    
    tipoMov = Me.TIPO_MOV.Value
    
    If tipoMov = "ENTRADA" Then
            capacidad = DLookup("CAPACIDAD", "LOCACIONES", "ID_LOC=" & Forms![MOVIMIENTOS DE INVENTARIOS]!ComboBoxID_LOC)
            utilizada = DLookup("CAP_UTILIZADA", "LOCACIONES", "ID_LOC=" & Forms![MOVIMIENTOS DE INVENTARIOS]!ComboBoxID_LOC)
            Me.LabelCAPACIDAD.Caption = "Capacidad Disponible: " & capacidad - utilizada
    End If

Exit Sub
Err:
    MsgBox "Un error ha ocurrido: " & Err.Description, vbCritical + vbOKOnly
End Sub

Private Sub Form_Load()
    'Mostrar Nombre el Producto
    Me.LabelPRODUCTO.Caption = DLookup("NOMBRE_PRODUCTO", "PRODUCTOS", "ID_PRODUCTO=" & Forms![INVENTARIOS DE PRODUCTO]!ComboBUSCAR_PRODUCTO)
End Sub


Private Sub Form_Open(Cancel As Integer)
    Me.LabelCAPACIDAD.Caption = ""
End Sub

Private Sub TIPO_MOV_AfterUpdate()

Dim tipoMov As String
    
tipoMov = Me.TIPO_MOV.Value

'ACTIVAR/DESACTIVAR CONTROLES
    If tipoMov = "SALIDA" Then
            Me.LOTE.Enabled = False
            Me.CADUCIDAD.Enabled = False
            Me.ComboBoxID_LOC.Enabled = False
        Else
            Me.LOTE.Enabled = True
            Me.CADUCIDAD.Enabled = True
            Me.ComboBoxID_LOC.Enabled = True
    End If

End Sub



CÓDIGOS DE FORMULARIO INVENTARIOS DE PRODUCTO


Option Compare Database

Private Sub Form_Load()
DoCmd.Maximize
DoCmd.GoToRecord , , acFirst
End Sub




ANTERIOR        INDICE     SIGUIENTE

1 comentario:

  1. Buenos dias Ing. Arturo. Me parece muy buen material. Gracias de nuevo por campartir tanto conocimiento. Puedo decir que me aclaró muchas dudas sobre el manejo de inventarios y su programación o automatización. Lo único que no vi fue en que modulo actualiza las cantidades mínimas y máximas que refleja el subformulario de rangos de inventario. Me gustaría conocer algo al respecto, de primer momento pense que eran cargados en el registro del producto, pero vi que no fue así.

    ResponderBorrar

Entradas populares