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
CÓDIGO DE MODULO DE VALIDACIONCAMPOS
CÓDIGOS DE FORMULARIO MOVIMIENTOS DE INVENTARIOS
CÓDIGOS DE FORMULARIO INVENTARIOS DE PRODUCTO
ANTERIOR INDICE SIGUIENTE
VER VÍDEO EXPLICACIÓNAquí 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
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