En este artículo les comparto una macro para el registro de entradas y salidas de mercancía.
Si se desea pueden instalar el lector de código de barras para buscar productos de forma automática de lo contrario solo basta escribir el código de manera manual y presionar la tecla enter.
Los pasos a seguir son los siguientes:
1.-Ingresar al editor de VBA Excel. Alt + F11.
2.-Hacer un formulario como se muestra.
Formulario entradas y salidas
4.-Escribir el siguiente código.
Public wsh As Worksheet
Public strrutaimagen As String
Public strtipodoc As String
Public strhoradoc As String
Public strleyeli1 As String
Public strleyeli2 As String
Public strinfstoc As String
Public intagr As Integer
Public intconta As Integer
Private Sub UserForm_Initialize()
'Cargamos un nuevo folio
Me.txtfolio.Text = Hoja7.Cells(5, 2) + 1
'Leyenda a los reportes
strleyeli1 = Hoja7.Cells(17, 2)
strleyeli2 = Hoja7.Cells(18, 2)
'Informar sobre stock bajo
strinfstoc = Hoja7.Cells(19, 2)
'Agregamos formas de pago
Me.cboformpag.AddItem "EFECTIVO"
Me.cboformpag.AddItem "TARJETA DE CREDITO"
Me.cboformpag.AddItem "TARJETA DE DEBITO"
Me.cboformpag.AddItem "CHEQUE"
Me.cboformpag.AddItem "TRANSFERENCIA"
Me.cboformpag.AddItem "CREDITO"
Me.cboformpag.Text = "EFECTIVO"
Me.cbotipmov.AddItem "1.-COMPRA+"
Me.cbotipmov.AddItem "2.-COTIZACION"
Me.cbotipmov.AddItem "3.-TIKETS-"
Me.cbotipmov.AddItem "4.-AJUSTE+"
Me.cbotipmov.AddItem "5.-MERMA-"
Me.cbotipmov.Text = "3.-TIKETS-"
Me.txttotal.Locked = True
Me.txtcambio.Locked = True
'Asignamos fecha
Me.txtfecha.Text = Date
'Definimos encabezado en ListBox
EncabezadoListBox
Permisos
End Sub
Private Sub lblmenu_Click()
Application.CommandBars("cell").Reset
Dim Op_Menu As CommandBarControl
For Each Op_Menu In Application.CommandBars("cell").Controls
Op_Menu.Visible = False
Next Op_Menu
With Application.CommandBars("cell").Controls.Add(Temporary:=True, before:=1)
.Caption = "Artículos"
.OnAction = "mArticulos"
.FaceId = 6728
If strarticulo <> "SI" Then .Enabled = False
End With
With Application.CommandBars("cell").Controls.Add(Temporary:=True, before:=2)
.Caption = "Proveedores"
.OnAction = "mProveedores"
.FaceId = 3709
If strproveedo <> "SI" Then .Enabled = False
End With
With Application.CommandBars("cell").Controls.Add(Temporary:=True, before:=3)
.Caption = "Clientes"
.OnAction = "mClientes"
.FaceId = 7244
If strclientes <> "SI" Then .Enabled = False
End With
With Application.CommandBars("cell").Controls.Add(Temporary:=True, before:=4)
.Caption = "Parametros"
.OnAction = "mParametros"
.FaceId = 718
.Enabled = True
End With
Application.CommandBars("cell").ShowPopup
Permisos
End Sub
Private Sub cbotipmov_Change()
If Me.cbotipmov.ListIndex + 1 = 1 Then Me.txtfolio.Text = Hoja7.Cells(1, 2) + 1
If Me.cbotipmov.ListIndex + 1 = 2 Then Me.txtfolio.Text = Hoja7.Cells(3, 2) + 1
If Me.cbotipmov.ListIndex + 1 = 3 Then Me.txtfolio.Text = Hoja7.Cells(5, 2) + 1
If Me.cbotipmov.ListIndex + 1 = 4 Then Me.txtfolio.Text = Hoja7.Cells(7, 2) + 1
If Me.cbotipmov.ListIndex + 1 = 5 Then Me.txtfolio.Text = Hoja7.Cells(9, 2) + 1
Permisos
End Sub
Private Sub cmdfolios_Click()
frm_listardocumen.cbotipmov.Text = Me.cbotipmov.Text
frm_listardocumen.Show
End Sub
Private Sub txtcodigo_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = 13 Then
BuscarPersona
Me.txtclave.SetFocus
'If intagr = 1 Then
' AgregarProducto
'End If
End If
Permisos
End Sub
Private Sub cmdpersonas_Click()
If Me.cbotipmov.ListIndex + 1 = 1 Or Me.cbotipmov.ListIndex + 1 = 4 Then
frm_listarpersonas.Caption = "Proveedores"
frm_listarpersonas.cmdnuevo.Caption = "Nuevo proveedor"
frm_listarpersonas.cmdnuevo.Accelerator = "N"
frm_listarpersonas.txtpersona.Text = "Proveedores"
frm_listarpersonas.txtcadena.Text = frm_movimientos.txtcodigo.Text
frm_listarpersonas.Show
End If
If Me.cbotipmov.ListIndex + 1 = 2 Or Me.cbotipmov.ListIndex + 1 = 3 Or Me.cbotipmov.ListIndex + 1 = 5 Then
frm_listarpersonas.Caption = "Clientes"
frm_listarpersonas.cmdnuevo.Caption = "Nuevo cliente"
frm_listarpersonas.cmdnuevo.Accelerator = "N"
frm_listarpersonas.txtpersona.Text = "Clientes"
frm_listarpersonas.txtcadena.Text = frm_movimientos.txtcodigo.Text
frm_listarpersonas.Show
End If
Permisos
End Sub
Private Sub txtclave_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = 13 Then
BuscarProducto
Me.txtcantidad.SetFocus
'If intagr = 1 Then
' AgregarProducto
'End If
End If
Permisos
End Sub
Private Sub txtcantidad_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = 13 Then
'Se verifica si es inventariable y el stock
If strinfstoc = "SI" And Me.txtinventa.Text = "SI" And Me.txtstock.Text < Me.txtcantidad.Text Then
MsgBox "Las cantidad es mayor a la existencias", vbOKOnly + vbExclamation, "Stock bajo"
End If
If intagr = 1 Then
AgregarProducto
End If
Me.txtinventa.Text = ""
Me.txtstock.Text = 0
End If
Permisos
End Sub
Private Sub txtprecio_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = 13 Then
If intagr = 1 Then
AgregarProducto
End If
End If
Permisos
End Sub
Private Sub txtcantidad_Change()
'Calculamos el importe de la partida al modificar la cantidad
ImportePartida
End Sub
Private Sub txtprecio_Change()
'Calculamos el importe de la partida al modificar el precio
ImportePartida
End Sub
Private Sub ImportePartida()
Dim curcant As Currency
Dim curprec As Currency
Dim curimpo As Currency
'Si no se escriben numeros asignamos valor 1 a cantidad y precio
If Not IsNumeric(Me.txtcantidad.Text) Or Me.txtcantidad.Text = "" Then Me.txtcantidad.Text = 0
If Not IsNumeric(Me.txtprecio.Text) Or Me.txtprecio.Text = "" Then Me.txtprecio.Text = 0
curcant = Me.txtcantidad.Text
curprec = Me.txtprecio.Text
curimpo = curcant * curprec
Me.txtimporte.Text = Format(curimpo, "##,##0.00")
End Sub
Private Sub RealizarSuma()
Dim intfila As Integer
Dim curcant As Currency
Dim cursuma As Currency
On Error GoTo ErrorNum
curcant = 0: cursuma = 0
If Me.ListBox1.ListCount = 0 Then Exit Sub
'Recorremos la columna 5 de ListBox para calcular el total a pagar
For intfila = 1 To Me.ListBox1.ListCount - 1
curcant = curcant + Me.ListBox1.List(intfila, 1)
cursuma = cursuma + Me.ListBox1.List(intfila, 5)
Next intfila
Me.txttotal.Text = Format(cursuma, "##,##0.00")
Me.txtrecibido.Text = Format(cursuma, "##,##0.00")
'Mostramos el total de las partidas
Me.Label21.Caption = "TOTAL DE PARTIDAS " & ListBox1.ListCount - 1
Me.Label12.Caption = "TOTAL DE ARTICULOS " & curcant
ErrorNum:
If Err.Number <> 0 Then
MsgBox ("Se ha producido un error" & vbNewLine & "Error número: " & Err.Number & vbNewLine & "Descripción: " & Err.Description & vbNewLine & "PtoVta")
End If
End Sub
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim strcodigo As String
Dim curcantid As Currency
Dim curprecio As Currency
Dim curimport As Currency
Dim strnombre As String
On Error GoTo ErrorNum
strcodigo = Me.ListBox1.Column(0)
curcantid = Me.ListBox1.Column(1)
strnombre = Me.ListBox1.Column(3)
Me.txtinventa.Text = Me.ListBox1.Column(6)
Me.txtstock.Text = Me.ListBox1.Column(7)
curcantid = Application.InputBox(Prompt:=strnombre, Title:="CODIGO: " & strcodigo, Default:=curcantid, Type:=1)
If curcantid = 0 Then MsgBox "Capture un numero", vbExclamation, "PtoVta": Exit Sub
curprecio = Me.ListBox1.Column(4)
curimport = curcantid * curprecio
Me.ListBox1.Column(1) = Format(curcantid, "##0.000")
Me.ListBox1.Column(5) = Format(curimport, "##0.000")
RealizarSuma
'Se verifica si es inventariable y el stock
If strinfstoc = "SI" And Me.txtinventa.Text = "SI" And Me.txtstock.Text < curcantid Then
MsgBox "Las cantidad es mayor a la existencias", vbOKOnly + vbExclamation, "Stock bajo"
End If
Permisos
ErrorNum:
If Err.Number <> 0 Then
MsgBox ("Se ha producido un error" & vbNewLine & "Error número: " & Err.Number & vbNewLine & "Descripción: " & Err.Description & vbNewLine & "PtoVta")
End If
End Sub
Private Sub ListBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = 46 Then
EliminarPartida
End If
Permisos
End Sub
Private Sub txtrecibido_Change()
'Aquí se calcula el cambio a dar
If Not IsNumeric(Me.txtrecibido.Text) Then Me.txtrecibido.Text = 0#
If Me.txtrecibido.Text = "" Then Me.txtrecibido.Text = 0#
Me.txtcambio.Text = Format(Me.txtrecibido.Text - Me.txttotal.Text, "##,##0.00")
End Sub
Private Sub cmdlistararticulos_Click()
frm_listararticulos.txtcadena.Text = frm_movimientos.txtclave.Text
frm_listararticulos.Show
Permisos
End Sub
Private Sub cmdagregar_Click()
AgregarProducto
Permisos
End Sub
Private Sub cmdeliminar_Click()
EliminarPartida
Permisos
End Sub
Private Sub cmdguardar_Click()
Dim rng1 As Range
Dim strclavepro As String
Dim curcantidad As Currency
Dim strunidadme As String
Dim strnombrear As String
Dim curprecioun As Currency
Dim cur_importe As Currency
Dim strinventar As String
Dim curexistact As Currency
Dim intregistros1 As Integer
Dim intregistros2 As Integer
Dim intrespuesta As Integer
Dim intfila As Integer
strtipodoc = Str(Me.cbotipmov.ListIndex + 1)
Me.txtfecha.Text = Date
strhoradoc = Time
intregistros1 = Hoja4.Range("A1").CurrentRegion.Rows.Count
'Nos pregunta si deseamos guardar la entrada
intrespuesta = MsgBox("¿Los datos son correctos?", vbYesNo + vbQuestion, "Antes de guardar")
'Si la respuesta es ya no continua ejecutándose la subrutina
If intrespuesta = vbNo Then Exit Sub
'Guardamos el registro
Hoja4.Cells(intregistros1 + 1, 1) = intregistros1
Hoja4.Cells(intregistros1 + 1, 2) = strtipodoc
Hoja4.Cells(intregistros1 + 1, 3) = Format(Me.txtfecha.Text, "mm/dd/yyyy")
Hoja4.Cells(intregistros1 + 1, 4) = strhoradoc
Hoja4.Cells(intregistros1 + 1, 5) = Me.txtfolio.Text
Hoja4.Cells(intregistros1 + 1, 6) = Me.txtcodigo.Text
Hoja4.Cells(intregistros1 + 1, 7) = Me.txttotal.Text
Hoja4.Cells(intregistros1 + 1, 8) = Me.cboformpag.Text
Hoja4.Cells(intregistros1 + 1, 9) = Me.txtobservacion.Text
Hoja4.Cells(intregistros1 + 1, 10) = "VIGENTE"
'Actualizamos folio
If Me.cbotipmov.ListIndex + 1 = 1 Then Hoja7.Cells(1, 2) = Hoja7.Cells(1, 2) + 1
If Me.cbotipmov.ListIndex + 1 = 2 Then Hoja7.Cells(3, 2) = Hoja7.Cells(3, 2) + 1
If Me.cbotipmov.ListIndex + 1 = 3 Then Hoja7.Cells(5, 2) = Hoja7.Cells(5, 2) + 1
If Me.cbotipmov.ListIndex + 1 = 4 Then Hoja7.Cells(7, 2) = Hoja7.Cells(7, 2) + 1
If Me.cbotipmov.ListIndex + 1 = 5 Then Hoja7.Cells(9, 2) = Hoja7.Cells(9, 2) + 1
'Guarda los datos de cada partida del listbox
For intfila = 1 To Me.ListBox1.ListCount - 1
'Limpiar variables
strclavepro = "": curcantidad = 0: strunidadme = "": strnombrear = "": curprecioun = 0: cur_importe = 0: strinventar = "": curexistact = 0
'Solicitamos datos
strclavepro = Me.ListBox1.List(intfila, 0)
curcantidad = Me.ListBox1.List(intfila, 1)
strunidadme = Me.ListBox1.List(intfila, 2)
strnombrear = Me.ListBox1.List(intfila, 3)
curprecioun = Me.ListBox1.List(intfila, 4)
cur_importe = Me.ListBox1.List(intfila, 5)
strinventar = Me.ListBox1.List(intfila, 6)
curexistact = Me.ListBox1.List(intfila, 7)
'Realizamos consultas y cálculos
'Buscamos producto
Set rng1 = Hoja1.Range("A:A").Find(What:=strclavepro, LookAt:=xlWhole, LookIn:=xlValues)
If rng1 Is Nothing Then
MsgBox "El producto no existe", vbOKOnly + vbInformation, "No encontrado"
Else
'Obtenemos SI es INVENTARIABLE
strinventar = Hoja1.Range("F" & rng1.Row)
'Obtenemos el stock del producto
curexistact = Format(Hoja1.Range("G" & rng1.Row), "##0.000")
If strinventar = "SI" And (Me.cbotipmov.ListIndex + 1 = 1 Or Me.cbotipmov.ListIndex + 1 = 4) Then
'Obtenemos nuevo stock del producto
curexistact = curexistact + curcantidad
End If
If strinventar = "SI" And (Me.cbotipmov.ListIndex + 1 = 3 Or Me.cbotipmov.ListIndex + 1 = 5) Then
'Obtenemos nuevo stock del producto
curexistact = curexistact - curcantidad
End If
'Actualizamos existencia
Hoja1.Range("G" & rng1.Row) = curexistact
End If
'Guardamos datos
'Obtenemos la última fila
intregistros2 = Hoja5.Range("A1").CurrentRegion.Rows.Count
Hoja5.Cells(intregistros2 + 1, 1) = intregistros2
Hoja5.Cells(intregistros2 + 1, 2) = intregistros1
Hoja5.Cells(intregistros2 + 1, 3) = strclavepro
Hoja5.Cells(intregistros2 + 1, 4) = curcantidad
Hoja5.Cells(intregistros2 + 1, 5) = strunidadme
Hoja5.Cells(intregistros2 + 1, 6) = strnombrear
Hoja5.Cells(intregistros2 + 1, 7) = Format(curprecioun, "##,##0.000")
Hoja5.Cells(intregistros2 + 1, 8) = Format(cur_importe, "##,##0.000")
Hoja5.Cells(intregistros2 + 1, 9) = Format(curexistact, "##,##0.000")
Next intfila
MsgBox "El registro fue guardado con éxito", vbOKOnly + vbInformation, "PtoVta"
'Invoca el código imprimir tikets
ImprimirTikets
'Aumenta un folio más una vez guardado el registro
Me.txtfolio.Text = Me.txtfolio.Text + 1
'Bloquea el boton guardar e imprimir
Me.cmdguardar.Enabled = False
Me.cmdbuscar.Enabled = True
Me.cbotipmov.Enabled = True
LimpiarControles
Me.txtcodigo.SetFocus
Permisos
End Sub
Private Sub cmdbuscar_Click()
'Invocamos las subrutinas para buscar un folio
BuscarDocumento
BuscarPersona
BuscarDetalle
RealizarSuma
Permisos
End Sub
Private Sub cmdcancelar_Click()
Dim rng1 As Range
Dim strclavepro As String
Dim curcantidad As Currency
Dim strunidadme As String
Dim strnombrear As String
Dim curprecioun As Currency
Dim cur_importe As Currency
Dim strinventar As String
Dim curexistact As Currency
Dim intregistros1 As Integer
Dim intregistros2 As Integer
Dim intrespuesta As Integer
Dim intfila As Integer
strtipodoc = Str(Me.cbotipmov.ListIndex + 1)
Me.txtfecha.Text = Date
strhoradoc = Time
intregistros1 = Hoja4.Range("A1").CurrentRegion.Rows.Count
'Nos pregunta si deseamos guardar la entrada
intrespuesta = MsgBox("¿Desea cancelar el documento?", vbYesNo + vbQuestion, "Antes de cancelar")
'Si la respuesta es ya no continua ejecutándose la subrutina
If intrespuesta = vbNo Then Exit Sub
'Modificamos el registro como cancelado columna estatus
Hoja4.Cells(intconta, 10) = "CANCELADO"
intconta = 0
'Guarda los datos de cada partida del listbox
For intfila = 1 To Me.ListBox1.ListCount - 1
'Limpiar variables
strclavepro = "": curcantidad = 0: strunidadme = "": strnombrear = "": curprecioun = 0: cur_importe = 0: strinventar = "": curexistact = 0
'Solicitamos datos
strclavepro = Me.ListBox1.List(intfila, 0)
curcantidad = Me.ListBox1.List(intfila, 1)
strunidadme = Me.ListBox1.List(intfila, 2)
strnombrear = Me.ListBox1.List(intfila, 3)
curprecioun = Me.ListBox1.List(intfila, 4)
cur_importe = Me.ListBox1.List(intfila, 5)
'Realizamos consultas y cálculos
'Buscamos producto
Set rng1 = Hoja1.Range("A:A").Find(What:=strclavepro, LookAt:=xlWhole, LookIn:=xlValues)
If rng1 Is Nothing Then
MsgBox "El producto no existe", vbOKOnly + vbInformation, "No encontrado"
Else
'Obtenemos SI es INVENTARIABLE
strinventar = Hoja1.Range("F" & rng1.Row)
'Obtenemos el stock del producto
curexistact = Format(Hoja1.Range("G" & rng1.Row), "##0.000")
If strinventar = "SI" And (Me.cbotipmov.ListIndex + 1 = 1 Or Me.cbotipmov.ListIndex + 1 = 4) Then
'Obtenemos nuevo stock del producto
curexistact = curexistact - curcantidad
End If
If strinventar = "SI" And (Me.cbotipmov.ListIndex + 1 = 3 Or Me.cbotipmov.ListIndex + 1 = 5) Then
'Obtenemos nuevo stock del producto
curexistact = curexistact + curcantidad
End If
'Actualizamos existencia
Hoja1.Range("G" & rng1.Row) = curexistact
End If
'Guardamos datos
'Obtenemos la última fila
intregistros2 = Hoja5.Range("A1").CurrentRegion.Rows.Count
Hoja5.Cells(intregistros2 + 1, 1) = intregistros2
Hoja5.Cells(intregistros2 + 1, 2) = "CA-" & Me.txtiddocum.Text
Hoja5.Cells(intregistros2 + 1, 3) = strclavepro
Hoja5.Cells(intregistros2 + 1, 4) = curcantidad
Hoja5.Cells(intregistros2 + 1, 5) = strunidadme
Hoja5.Cells(intregistros2 + 1, 6) = strnombrear
Hoja5.Cells(intregistros2 + 1, 7) = Format(curprecioun, "##,##0.000")
Hoja5.Cells(intregistros2 + 1, 8) = Format(cur_importe, "##,##0.000")
Hoja5.Cells(intregistros2 + 1, 9) = Format(curexistact, "##,##0.000")
Next intfila
MsgBox "El registro fue cancelado con éxito", vbOKOnly + vbInformation, "PtoVta"
'Bloquea el botón guardar e imprimir
Me.cmdguardar.Enabled = False
Me.cmdbuscar.Enabled = True
Me.cmdcancelar.Enabled = False
'Me.cbotipmov.Enabled = False
Permisos
End Sub
Private Sub cmdimprimir_Click()
'Invoca la subrutina imprimir tikets
ImprimirTikets
Permisos
End Sub
Private Sub cmdexportar_Click()
Dim strnombre As String
Dim strruta As String
Dim intrespuesta As Integer
GenerarReporte
'Nos pregunta si deseamos exportar el documento
intrespuesta = MsgBox("¿Desea exportar el documento?", vbYesNo + vbQuestion, "Antes de exportar")
'Si la respuesta es ya no continua ejecutándose la subrutina
If intrespuesta = vbNo Then Exit Sub
strruta = Hoja7.Cells(9, 2)
strnombre = "Tikets" & Hoja7.Cells(2, 2) & Me.txtfolio.Text & ".pdf"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
strruta & strnombre, Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=True
MsgBox "El documento fue exportado con éxito", vbOKOnly + vbInformation, "PtoVta"
Permisos
End Sub
Private Sub EncabezadoListBox()
Dim intfila As Integer
'Definimos el número de columnas
Me.ListBox1.ColumnCount = 8
'Definimos el ancho de cada columna
Me.ListBox1.ColumnWidths = "60;60;60;150;80;80;0;0"
'Limpiar el lixtbox
ListBox1.Clear
'Agregar el elemento en las respectivas columnas
ListBox1.AddItem
intfila = ListBox1.ListCount - 1
'Agregamos los encabezados al listbox
ListBox1.Column(0, intfila) = "CLAVE"
ListBox1.Column(1, intfila) = "CANTIDAD"
ListBox1.Column(2, intfila) = "UNIDAD"
ListBox1.Column(3, intfila) = "NOMBRE"
ListBox1.Column(4, intfila) = "PRECIO"
ListBox1.Column(5, intfila) = "IMPORTE"
ListBox1.Column(6, intfila) = ""
ListBox1.Column(7, intfila) = ""
End Sub
Private Sub AgregarProducto()
'Agrega el producto de los textbox al LitBox
If intagr = 0 Then MsgBox "No hay nada que agregar", vbOKOnly + vbExclamation, "Error": Exit Sub
If Me.txtcantidad.Text = 0 Then Exit Sub
If Me.txtprecio.Text = 0 Then Exit Sub
With Me.ListBox1
x = .ListCount
.AddItem
.List(x, 0) = Me.txtclave.Text
.List(x, 1) = Format(Me.txtcantidad.Text, "##,##0.00")
.List(x, 2) = Me.txtunidad.Text
.List(x, 3) = Me.txtdescripc.Text
.List(x, 4) = Format(Me.txtprecio.Text, "##,##0.00")
.List(x, 5) = Format(Me.txtimporte.Text, "##,##0.00")
.List(x, 6) = Me.txtinventa.Text
.List(x, 7) = Me.txtstock.Text
End With
'Calcula la suma
RealizarSuma
'Se posiciona en el textbox clave del producto
Me.txtclave.SetFocus
'Limpia los controles
Me.txtclave.Text = Empty
Me.txtcantidad.Text = 0
Me.txtunidad.Text = Empty
Me.txtdescripc.Text = Empty
Me.txtprecio.Text = 0
Me.txtimporte.Text = 0
Me.cbotipmov.Enabled = False
'Si el LixtBox2 contiene mas de 2 partidas incluyendo los encabezados que habilite el botón guardar, bloquee el de imprimir y exportar
If Me.ListBox1.ListCount >= 2 Then Me.cmdguardar.Enabled = True: Me.cmdbuscar.Enabled = False: Me.cmdimprimir.Enabled = False: Me.cmdexportar.Enabled = False
Permisos
End Sub
Private Sub EliminarPartida()
On Error GoTo ErrorNum
'Si ListBox no contiene nada que no continué ejecutándose el código y que salga
If Me.ListBox1.ListIndex = 0 Then Exit Sub
'Si ListBox contiene un elemento en este caso los encabezados no permite que continué ejecutándose el código y que salga
If Me.ListBox1.ListCount = 1 Then Exit Sub
'Si las condiciones anteriores no se cumplieron entonces pregunta
'Si el elemento seleccionado es diferente de -1 que son los encabezados
If Me.ListBox1.ListIndex <> -1 Then
'Que elimine el elemento seleccionado
Me.ListBox1.RemoveItem ListBox1.ListIndex
'Calcula nuevamente la suma
RealizarSuma
'Si ListBox1 contiene un solo elemento que por ende son los encabezados
If Me.ListBox1.ListCount = 1 Then
'Bloque el boton guardar, buscar, imprimir, exportar
Me.cmdguardar.Enabled = False
Me.cmdbuscar.Enabled = False
Me.cmdimprimir.Enabled = False
Me.cmdexportar.Enabled = False
End If
End If
ErrorNum:
If Err.Number <> 0 Then
MsgBox ("Se ha producido un error" & vbNewLine & "Error número: " & Err.Number & vbNewLine & "Descripción: " & Err.Description & vbNewLine & "PtoVta")
End If
End Sub
Private Sub BuscarDocumento()
Dim inttipo As Integer
Dim lngfolio As Long
Dim intvalor As Integer
Dim intregistros As Integer
'Cuenta el numero de registros de la hoja4 documentos
intregistros = Hoja4.Range("A1").CurrentRegion.Rows.Count
intvalor = 0
'Recorre todos los registros
For intconta = 2 To intregistros
'Almacena el tipo de documento
inttipo = Hoja4.Cells(intconta, 2)
'Almacena el numero de folio
lngfolio = Hoja4.Cells(intconta, 5)
'Si numero de folio almacenado es igual folio capturado a buscar, y el tipo de documento almacenado es igual a 1
If lngfolio = Me.txtfolio.Text And inttipo = Me.cbotipmov.ListIndex + 1 Then
'IMPORTANTE Guarda en memoria el ID del documento
Me.txtiddocum.Text = Hoja4.Cells(intconta, 1)
'Agrega el registro a los textbox
Me.txtfecha.Text = Hoja4.Cells(intconta, 3)
'Guarda en memoria la hora del documento para imprimirlo
strhoradoc = Hoja4.Cells(intconta, 4)
Me.txtfolio.Text = Hoja4.Cells(intconta, 5)
Me.txtcodigo.Text = Hoja4.Cells(intconta, 6)
Me.cboformpag.Text = Hoja4.Cells(intconta, 8)
Me.txtobservacion.Text = Hoja4.Cells(intconta, 9)
'Inhabilita los botones agregar, eliminar
Me.cmdagregar.Enabled = False
Me.cmdeliminar.Enabled = False
Me.ListBox1.Locked = True
'Habilita el botón imprimir y exportar pdf
Me.cmdimprimir.Enabled = True
Me.cmdexportar.Enabled = True
Me.cmdcancelar.Enabled = True
If Hoja4.Cells(intconta, 10) = "CANCELADO" Then
Me.cmdcancelar.Enabled = False
End If
intvalor = 1
Exit For
End If
Next intconta
If intvalor = 0 Then
MsgBox "El documento no existe", vbInformation, "No encontrado"
End If
End Sub
Private Sub BuscarProducto()
Dim strcla As String
Dim intval As Integer
Dim intregistros As Integer
'Contamos el numero de registros en la hoja 1
intregistros = Hoja1.Range("A1").CurrentRegion.Rows.Count
intval = 0
intagr = 0
'Recorre todos los registros
For intcon = 2 To intregistros
'Almacena la clave del producto
strcla = Hoja1.Cells(intcon, 1)
'Si la clave corresponde a la clave del producto capturado por el usuario
If strcla = Me.txtclave.Text Then
'Cargar datos del producto a los textbox
Me.txtinventa.Text = Hoja1.Cells(intcon, 6)
Me.txtstock.Text = Hoja1.Cells(intcon, 7)
Me.txtunidad.Text = Hoja1.Cells(intcon, 2)
Me.txtdescripc.Text = Hoja1.Cells(intcon, 3)
If Me.cbotipmov.ListIndex + 1 = 1 Or Me.cbotipmov.ListIndex + 1 = 4 Then
Me.txtprecio.Text = Format(Hoja1.Cells(intcon, 4), "##,##0.00")
End If
If Me.cbotipmov.ListIndex + 1 = 2 Or Me.cbotipmov.ListIndex + 1 = 3 Or Me.cbotipmov.ListIndex + 1 = 5 Then
Me.txtprecio.Text = Format(Hoja1.Cells(intcon, 5), "##,##0.00")
End If
'Almacena en memoria la ruta de la imagen
strrutaimagen = Hoja1.Cells(intcon, 8)
intval = 1
intagr = 1
Exit For
End If
Next intcon
'Invoca la subrutina muestra la imagen del producto
MostrarImagen
If intval = 0 Then
MsgBox "El registro no existe", vbInformation, "No encontrado"
End If
End Sub
Private Sub BuscarPersona()
Dim intide As Integer
Dim intval As Integer
Dim intcon As Integer
Dim intregistros As Integer
If Me.txtcodigo.Text = "" Then Me.txtcodigo.Text = 0
If Me.cbotipmov.ListIndex + 1 = 1 Or Me.cbotipmov.ListIndex + 1 = 4 Then
Set wsh = Worksheets("Hoja2")
End If
If Me.cbotipmov.ListIndex + 1 = 2 Or Me.cbotipmov.ListIndex + 1 = 3 Or Me.cbotipmov.ListIndex + 1 = 5 Then
Set wsh = Worksheets("Hoja3")
End If
'Contamos el numero de registros en la hoja 2 o 3
intregistros = Hoja3.Range("A1").CurrentRegion.Rows.Count
intval = 0
'Recorre todos los registros
For intcon = 2 To intregistros
'Almacena el id del proveedor
intide = wsh.Cells(intcon, 1)
'Si el id corresponde al código del proveedor capturado por el usuario
If intide = Me.txtcodigo.Text Then
'Cargar datos del proveedor o cliente a los textbox
Me.txtnombre.Text = wsh.Cells(intcon, 2)
Me.txtdireccion.Text = wsh.Cells(intcon, 3)
intval = 1
Exit For
End If
Next intcon
If intval = 0 Then
MsgBox "El registro no existe", vbInformation, "No encontrado"
End If
End Sub
Private Sub BuscarDetalle()
Dim intcont As Integer
Dim intfila As Integer
Dim striden As String
'Contamos el numero de registros en la hoja 5
intregistros = Hoja5.Range("A1").CurrentRegion.Rows.Count
'Limpiamos el LixtBox
Me.ListBox1.Clear
'Agregamos el encabezado al ListBox
EncabezadoListBox
'Recorre todos los registros
For intcont = 2 To intregistros
'IMPORTANTE aquí guarda el ID del documento, no el folio
striden = Hoja5.Cells(intcont, 2)
'Si el ID de la hoja detalles es igual al ID del documento almacenado en memoria
If striden = Me.txtiddocum.Text Then
'Agrega las partidas al ListBox que correspondan al ID del documento
Me.ListBox1.AddItem
intfila = Me.ListBox1.ListCount - 1
Me.ListBox1.Column(0, intfila) = Hoja5.Cells(intcont, 3)
Me.ListBox1.Column(1, intfila) = Format(Hoja5.Cells(intcont, 4), "##,##0.00")
Me.ListBox1.Column(2, intfila) = Hoja5.Cells(intcont, 5)
Me.ListBox1.Column(3, intfila) = Hoja5.Cells(intcont, 6)
Me.ListBox1.Column(4, intfila) = Format(Hoja5.Cells(intcont, 7), "##,##0.00")
Me.ListBox1.Column(5, intfila) = Format(Hoja5.Cells(intcont, 8), "##,##0.00")
End If
Next intcont
End Sub
Private Sub MostrarImagen()
On Error GoTo ErrorNum
'Disena y dibuja la imagen del producto
Set lblBtn = Me.Controls.Add("Forms.Image.1")
With lblBtn
.Name = "Foto"
.Picture = LoadPicture(strrutaimagen)
.PictureSizeMode = fmPictureSizeModeClip
.Top = 96
.Left = 492
.Width = 108
.Height = 84
End With
ErrorNum:
If Err.Number <> 0 Then
Me.Controls.Remove ("Foto")
End If
End Sub
Private Sub GenerarReporte()
Dim wsh As Worksheet
Dim strempre As String
Dim strdirec As String
Dim strtelef As String
Dim strserie As String
Dim i As Integer
Dim f As Integer
Dim fila As Integer
'Obtenemos datos que llevara el tikets
strempre = Hoja7.Cells(12, 2)
strdirec = Hoja7.Cells(13, 2)
strtelef = Hoja7.Cells(14, 2)
If Me.cbotipmov.ListIndex + 1 = 1 Then strserie = Hoja7.Cells(2, 2)
If Me.cbotipmov.ListIndex + 1 = 2 Then strserie = Hoja7.Cells(4, 2)
If Me.cbotipmov.ListIndex + 1 = 3 Then strserie = Hoja7.Cells(6, 2)
If Me.cbotipmov.ListIndex + 1 = 4 Then strserie = Hoja7.Cells(8, 2)
If Me.cbotipmov.ListIndex + 1 = 5 Then strserie = Hoja7.Cells(10, 2)
strcajer = Hoja7.Cells(15, 2)
'Activa la hoja 6
Set wsh = Worksheets("Hoja6")
wsh.Activate
'Desbloquea la hoja
wsh.Unprotect ("12345")
'Cuenta las filas llenas -2 filas
f = wsh.Cells(Rows.Count, 1).End(xlUp).Row - 2
'Selecciona el rango
wsh.Range("A" & f).Select
'Elimina el borde con xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
'Vuele a contar filas llevas
f = wsh.Cells(Rows.Count, 1).End(xlUp).Row
'Seleccina el rango y limpia las celdas
wsh.Range("A10:A" & f).ClearContents
'Envia datos del cliente a la hoja y datos del documento
wsh.Cells(1, 1) = strempre
wsh.Cells(2, 1) = strdirec
wsh.Cells(3, 1) = "TELÉFONO:" & strtelef
If Me.cbotipmov.ListIndex + 1 = 1 Then strtipodoc = "COMPRA"
If Me.cbotipmov.ListIndex + 1 = 2 Then strtipodoc = "COTIZACION"
If Me.cbotipmov.ListIndex + 1 = 3 Then strtipodoc = "TIKETS"
If Me.cbotipmov.ListIndex + 1 = 4 Then strtipodoc = "AJUSTE"
If Me.cbotipmov.ListIndex + 1 = 5 Then strtipodoc = "MERMA"
wsh.Cells(4, 1) = "SERIE Y FOLIO: " & strtipodoc & "-" & strserie & Me.txtfolio.Text
wsh.Cells(5, 1) = "ATENDIÓ: " & strcajer
wsh.Cells(6, 1) = "FECHA: " & Me.txtfecha.Text
wsh.Cells(7, 1) = "HORA: " & strhoradoc
wsh.Cells(8, 1) = "NOMBRE: " & Me.txtcodigo.Text & "-" & Me.txtnombre.Text & "-" & Me.txtdireccion.Text
'Inicia el contador fila en 8
fila = 8
'Selecciona y aplica un borde
wsh.Range("A" & fila).Select
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlDashDotDot
End With
'Coloca los encabezados del tikets
wsh.Cells(9, 1) = "CANTIDAD DESCRIPCIÓN PRECIO IMPORTE"
'Inicia en 0 el acumulador r y f
f = 0
'Recorre los registros de listbox
For i = 1 To Me.ListBox1.ListCount - 1
'Acumule el valor de la fila en cada vuelta
f = f + 2
'Envia a la hoja cantidad y nombre del producto del listbox
wsh.Cells(f + 8, 1) = Me.ListBox1.List(i, 1) & " - " & Me.ListBox1.List(i, 3)
Next i
'Inicia en 0 el acumulador f
f = 0
'Recorre nuevamente los registros del listbox
For i = 1 To Me.ListBox1.ListCount - 1
'Vuelve acumular el valor de la fila para insertar datos en las filas siguientes de la hoja
f = f + 2
'Envia a la hoja clave, precio e importe de la partida de listbox
wsh.Cells(f + 9, 1) = Me.ListBox1.List(i, 0) & " " & Me.ListBox1.List(i, 4) & " " & Me.ListBox1.List(i, 5)
Next i
'NOTA: la clave radica en f ya acumula el no de fila a enviar los datos en la primera imprime cantidad y nombre en fila 8+2
'que viene siendo la fila 10, luego en la otra vuelta del Listbox fila 12,14,16 etc ya que f=f+2 incrementa a 2.
'En el nuevo recorrido empieza en la fila 9 + 2, que seria 11,13,15 y asi sucesivamente
'Si el ultimo valor de f llego a 15 por ejemplo imprime forma de pago en la fila 15 + 10, seria fila 25
wsh.Cells(f + 10, 1) = "FORMA DE PAGO: " & Me.cboformpag.Text
wsh.Cells(f + 11, 1) = "OBSERVACIONES: " & Me.txtobservacion.Text
'Ahora la fila 15 + 11 imprime en la fila 26 el total
wsh.Cells(f + 12, 1) = " =TOTAL: " & Me.txttotal.Text
'En la fila 15 + 12 imprime en la fila 27 lo recibido
wsh.Cells(f + 13, 1) = " -RECIBIDO : " & Me.txtrecibido.Text
'Mientras que en la fila 15 + 13 imprime en la fila 28 el cambio
wsh.Cells(f + 14, 1) = " =CAMBIO : " & Me.txtcambio.Text
dblnumero = Me.txttotal.Text
Call LetraNumero
'Aquí imprime en la fila 15 + 14, fila 29
wsh.Cells(f + 15, 1) = "(" & strresult & ")"
'Vuelve a iniciar en 0 fila
fila = 0
'Acumula el valor de la fila f que seria fila 15 + 14, otra vez fila 29
fila = f + 15
'Selecciona el rango A29
wsh.Range("A" & fila).Select
'Aplica un borde
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlDashDotDot
End With
'En la fila 15 + 15, fila 30 imprime otro texto
wsh.Cells(f + 16, 1) = strleyeli1
'Y en la fila 15 + 16, fila 31 imprime otro texto
wsh.Cells(f + 17, 1) = strleyeli2
wsh.Protect ("12345")
End Sub
Private Sub ImprimirTikets()
Dim wsh As Worksheet
On Error GoTo ErrorNum
'Invoca la subrutina para que genere el tikets
GenerarReporte
'Abre el cuadro de dialogo para imprimir
Application.Dialogs(xlDialogPrint).Show
ErrorNum:
If Err.Number <> 0 Then
MsgBox ("Se ha producido un error" & vbNewLine & "Error número: " & Err.Number & vbNewLine & "Descripción: " & Err.Description)
End If
End Sub
Private Sub LimpiarControles()
'Limpia los controles
Me.txtcodigo.Text = Empty
Me.txtnombre.Text = Empty
Me.txtdireccion.Text = Empty
Me.txtclave.Text = Empty
Me.txtcantidad.Text = 1
Me.txtunidad.Text = Empty
Me.txtdescripc.Text = Empty
Me.txtprecio.Text = 1
Me.txtimporte.Text = 0
Me.txttotal.Text = 0
Me.txtobservacion.Text = Empty
Me.txtrecibido.Text = 0
Me.txtcambio.Text = 0
Me.ListBox1.Clear
'Establece nuevamente el encabezado de listbox cuando es necesario
EncabezadoListBox
End Sub
Private Sub Permisos()
If strmodiprec <> "SI" Then Me.txtprecio.Enabled = False
If strarticulo <> "SI" Then Me.cmdlistararticulos.Enabled = False
If strproveedo <> "SI" And Me.cbotipmov.ListIndex + 1 = 1 Then Me.cmdpersonas.Enabled = False
If strproveedo <> "SI" And Me.cbotipmov.ListIndex + 1 = 4 Then Me.cmdpersonas.Enabled = False
If strclientes <> "SI" And Me.cbotipmov.ListIndex + 1 = 2 Then Me.cmdpersonas.Enabled = False
If strclientes <> "SI" And Me.cbotipmov.ListIndex + 1 = 3 Then Me.cmdpersonas.Enabled = False
If strclientes <> "SI" And Me.cbotipmov.ListIndex + 1 = 5 Then Me.cmdpersonas.Enabled = False
If str_compras <> "SI" And Me.cbotipmov.ListIndex + 1 = 1 Then Me.txtclave.Enabled = False: Me.cmdguardar.Enabled = False
If strcotizaci <> "SI" And Me.cbotipmov.ListIndex + 1 = 2 Then Me.txtclave.Enabled = False: Me.cmdguardar.Enabled = False
If str_tickets <> "SI" And Me.cbotipmov.ListIndex + 1 = 3 Then Me.txtclave.Enabled = False: Me.cmdguardar.Enabled = False
If strcanticke <> "SI" And Me.cbotipmov.ListIndex + 1 = 3 Then Me.cmdcancelar.Enabled = False
If str_ajustes <> "SI" And Me.cbotipmov.ListIndex + 1 = 4 Then Me.txtclave.Enabled = False: Me.cmdguardar.Enabled = False
If str_mermasa <> "SI" And Me.cbotipmov.ListIndex + 1 = 5 Then Me.txtclave.Enabled = False: Me.cmdguardar.Enabled = False
If strcondocum <> "SI" Then Me.txtfolio.Enabled = False: Me.cmdbuscar.Enabled = False: Me.cmdimprimir.Enabled = False: Me.cmdexportar.Enabled = False
End Sub
3.-Agregamos 7 hojas con la siguiente información.
Hoja 1 Productos
En esta hoja nos invita a realizar una carpeta donde estarán las imágenes de cada producto si asi se desea, por lo que en caso de que así sea deben incluir en cada registro la ruta con el nombre de la imagen para que cuando se trabaje con el UserForm muestre la foto.
Hoja 2 Proveedores
Esta hoja estará compuesta por la lista de los proveedores a quienes se les compra la mercancía y así poder hacer las entradas.
Hoja 3 Clientes
En la hoja 3 debemos tener en lista a los clientes a quienes se les hará la salida de mercancía.
Hoja 4 Documentos Tipo 1 Entradas y Tipo 2 Salidas
Esta hoja es muy importante ya que es donde se guardaran las entradas y salidas. En este ejemplo el Userform guarda TIPO 1 Columna B, si deseas guardar salidas TIPO 2 deberás replicar el formulario y modificar la condición TIPO del código fuente a TIPO 2.
a) Botón GUARDAR.
Private Sub CommandButton5_Click()
'Tipo de documento 2 para salidas
Hoja4.Cells(intregistros1 + 1, 2) = 2
b) Botón BUSCAR.
Private Sub BuscarDocumento()
'Si Folio es igual al TextBox1 y al TIPO = 2 (Salidas)
If intfolio = Me.TextBox1.Text And inttipo = 2 Then
Hoja 5 Detalles
Esta hoja es importante ya que en ella se guardaran todas las partidas tanto de entradas como de salidas.
Hoja 6 formato tikets 8 mm
La Hoja 6 muestro la plantilla que cada uno de ustedes puede diseñar para imprimir la entrada o salida. En ejemplo el demo no integra ese código pero pueden consultar el artículo Como imprimir un tikets en formato de 8 mm.
Hoja 7 Configuraciones
La hoja 7 es importante ya que en ella se definen los folios tanto para entradas y salidas. Es decir cada vez que se realice una entrada o salida se modifican el valor de los folios actuales. Los datos adicionales es para que en la plantilla se muestren los datos del tikets de forma automática con código VBA o formula simple.
4.-fdfdfdf
No hay comentarios.:
Publicar un comentario