Como crear una factura o sale invoice y descontar de Stock o Inventario

En este post se muestra como crear una factura o sale invoice y descontar del Stock o Inventario los productos vendidos, esto fue un agregado por el pedido de un suscriptor, lo cual me pareció interesante y que podría servir de ejemplo a varios lectores, si alguno necesita una variante o que se agregue algo más en los ejemplos, es cuestión que lo propongan y si es útil a muchos lectores, realizo un ejemplo con ello; así que suscriban (YouTube, Suscribir a Web) para no perderse los ejemplos posteriores seguramente serán de utilidad o por lo menos dará alguna idea sobre como encarar una automatización de hojas de Excel o proyectos de VB.

El link de los post relacionados directamente con la creación de una Factura de Venta en Excel, seguidamente se listan.

Antes de seguir recomiendo leer un excelente libro sobre Excel que te ayudará operar las planillas u hojas de cálculo, haz click acá, si quieres aprender sobre Excel, en inglés, entonces debes hacer click here. Si lo que necesitas es aprender o profundizar sobre la programación de macros con VBA este es unos de los mejores cursos on line que he visto en internet.

Algo bastante importante al momento de facturar un producto es que el modulo de facturación se encuentre relacionado con la base de datos de los artículos y proceda a descontar del stock o inventario con el objeto de saber en cualquier momento con que cantidad de artículos hay en existencia y en que momento es necesario volver a comprar a los proveedores para mantener el stock o nivel de inventario, también es útil si se desea mantener un control del inventario.

En este ejemplo al momento de seleccionar el producto a facturar, se descuenta del stock, si se facturó por error algún producto, al realizar doble click sobre el listbox del formulario de venta se elimina del listbox, pero automáticamente se suma el stock que se restó y no se facturó.

Al momento de seleccionar en el textbox se determina el stock del producto, buscando el código del producto en la hoja Artículos, una vez encontrado el código se guarda en una variable publica la fila donde se encuentra el producto; con el siguiente código

Set codigo = a.Range(«B2:B» & filaedit).Find(cod, LookIn:=xlValues, LookAt:=xlWhole)
If Not codigo Is Nothing Then
stodir = codigo.Row
End If

Posteriormente cuando se ingresa la cantidad a facturar, se resta el stock actual menos la cantidad que se facturó, para ello se toma de la hoja Artículos el stock que hay en la fila y columna correspondiente y se le resta la cantidad cargada en el textbox al momento de facturar.

stoold = a1.Cells(stodir, «G»)
a1.Cells(stodir, «G») = a1.Cells(stodir, «G») – can

Cuando se anula o elimina un ítem del listbox, automáticamente se suma al stock actual la cantidad restada por error, desde el link del final se puede descargar el ejemplo de macro que permite crear una factura o sale invoice y descontar del stock.

El vídeo a continuación muestra como trabaja la macro; suscribe a nuestra web desde la parte superior derecha de la página ingresando tu mail y a nuestro canal de You Tube para recibir en tu correo vídeos explicativos sobre macros interesantes, como por ejemplo como mostar en listbox suma cuenta y promedio, buscar en listbox mientras escribes en textbox, como enviar mail en el cuerpo del mensaje con PDF adjunto, conectar Excel con Access, como rellenar un pagaré conectando Excel con Word y muchos ejemplos más.

if (payload.eventType == ‘subscribe’) {
// Add code to handle subscribe event.
} else if (payload.eventType == ‘unsubscribe’) {
// Add code to handle unsubscribe event.
}
if (window.console) { // for debugging only
window.console.log(‘YT event: ‘, payload);
}
}

Código que se inserta en un módulo
Public cod, art, mar, pv, ctr, creg, stodir As Long, can As Long
Sub muestra1()
UserForm2.Show
End Sub
Código que se inserta en un formulario

Private Sub CommandButton1_Click()
Unload Me
End Sub
Private Sub ListBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
On Error Resume Next
If KeyAscii = 13 Then
Set a = Sheets(«Articulos»)
filaedit = a.Range(«A» & Rows.Count).End(xlUp).Row
fila = Me.ListBox1.ListIndex
‘a.Cells(filaedit, «A») = ListBox1.List(fila, 0)
‘a.Cells(filaedit, «B») = ListBox1.List(fila, 1)
‘a.Cells(filaedit, «C») = ListBox1.List(fila, 2)
‘a.Cells(filaedit, «D») = ListBox1.List(fila, 3)
‘a.Cells(filaedit, «E») = ListBox1.List(fila, 4)
‘a.Cells(filaedit, «F») = ListBox1.List(fila, 5)
‘a.Cells(filaedit, «G») = ListBox1.List(fila, 6)
‘a.Cells(filaedit, «H») = ListBox1.List(fila, 7)
‘a.Cells(filaedit, «I») = ListBox1.List(fila, 8)
cod = ListBox1.List(fila, 1)
art = ListBox1.List(fila, 2)
mar = ListBox1.List(fila, 3)
pv = ListBox1.List(fila, 8)
Set codigo = a.Range(«B2:B» & filaedit).Find(cod, LookIn:=xlValues, LookAt:=xlWhole)
If Not codigo Is Nothing Then
stodir = codigo.Row
End If
End If
Unload UserForm1
UserForm3.Show
End Sub
Private Sub TextBox1_Change()
On Error Resume Next
Set b = Sheets(«Articulos»)
uf = b.Range(«A» & Rows.Count).End(xlUp).Row
If Trim(TextBox1.Value) = «» Then
Me.ListBox1.Clear
‘Me.ListBox1.List() = b.Range(«A2:H» & uf).Value
‘Me.ListBox1.RowSource = «Hoja2!A2:H» & uf
‘Adiciona un item al listbox reservado para la cabecera
UserForm1.ListBox1.AddItem
For i = 2 To uf
‘ strg = b.Cells(i, 4).Value
‘If UCase(strg) Like UCase(TextBox2.Value) & «» Then
Me.ListBox1.AddItem b.Cells(i, 1)
Me.ListBox1.List(Me.ListBox1.ListCount – 1, 1) = b.Cells(i, 2)
Me.ListBox1.List(Me.ListBox1.ListCount – 1, 2) = b.Cells(i, 3)
Me.ListBox1.List(Me.ListBox1.ListCount – 1, 3) = b.Cells(i, 4)
Me.ListBox1.List(Me.ListBox1.ListCount – 1, 4) = b.Cells(i, 5)
Me.ListBox1.List(Me.ListBox1.ListCount – 1, 5) = b.Cells(i, 6)
Me.ListBox1.List(Me.ListBox1.ListCount – 1, 6) = b.Cells(i, 7)
Me.ListBox1.List(Me.ListBox1.ListCount – 1, 7) = b.Cells(i, 8)
Me.ListBox1.List(Me.ListBox1.ListCount – 1, 8) = b.Cells(i, 9)
‘ End If
Next i
‘Carga los datos de la cabecera en listbox
For ii = 0 To 9
UserForm1.ListBox1.List(0, ii) = Sheets(«Articulos»).Cells(1, ii + 1)
Next ii
Exit Sub
End If
b.AutoFilterMode = False
Me.ListBox1.Clear
Me.ListBox1.RowSource = Clear
‘Adiciona un item al listbox reservado para la cabecera
UserForm1.ListBox1.AddItem
For i = 2 To uf
strg = b.Cells(i, 3).Value
If UCase(strg) Like UCase(TextBox1.Value) & «» Then
Me.ListBox1.AddItem b.Cells(i, 1)
Me.ListBox1.List(Me.ListBox1.ListCount – 1, 1) = b.Cells(i, 2)
Me.ListBox1.List(Me.ListBox1.ListCount – 1, 2) = b.Cells(i, 3)
Me.ListBox1.List(Me.ListBox1.ListCount – 1, 3) = b.Cells(i, 4)
Me.ListBox1.List(Me.ListBox1.ListCount – 1, 4) = b.Cells(i, 5)
Me.ListBox1.List(Me.ListBox1.ListCount – 1, 5) = b.Cells(i, 6)
Me.ListBox1.List(Me.ListBox1.ListCount – 1, 6) = b.Cells(i, 7)
Me.ListBox1.List(Me.ListBox1.ListCount – 1, 7) = b.Cells(i, 8)
Me.ListBox1.List(Me.ListBox1.ListCount – 1, 8) = b.Cells(i, 9)
End If
Next i
‘Carga los datos de la cabecera en listbox
For ii = 0 To 9
UserForm1.ListBox1.List(0, ii) = Sheets(«Articulos»).Cells(1, ii + 1)
Next ii
‘Me.ListBox1.ColumnWidths = «20 pt;70 pt;180 pt;80 pt;60 pt;60 pt;60 pt;60pt»
End Sub
Private Sub TextBox2_Change()
On Error Resume Next
Set b = Sheets(«Articulos»)
uf = b.Range(«A» & Rows.Count).End(xlUp).Row
If Trim(TextBox2.Value) = «» Then
Me.ListBox1.Clear
‘Me.ListBox1.List() = b.Range(«A2:H» & uf).Value
‘Me.ListBox1.RowSource = «Hoja2!A2:H» & uf
‘Adiciona un item al listbox reservado para la cabecera
UserForm1.ListBox1.AddItem
For i = 2 To uf
‘ strg = b.Cells(i, 4).Value
‘If UCase(strg) Like UCase(TextBox2.Value) & «» Then
Me.ListBox1.AddItem b.Cells(i, 1)
Me.ListBox1.List(Me.ListBox1.ListCount – 1, 1) = b.Cells(i, 2)
Me.ListBox1.List(Me.ListBox1.ListCount – 1, 2) = b.Cells(i, 3)
Me.ListBox1.List(Me.ListBox1.ListCount – 1, 3) = b.Cells(i, 4)
Me.ListBox1.List(Me.ListBox1.ListCount – 1, 4) = b.Cells(i, 5)
Me.ListBox1.List(Me.ListBox1.ListCount – 1, 5) = b.Cells(i, 6)
Me.ListBox1.List(Me.ListBox1.ListCount – 1, 6) = b.Cells(i, 7)
Me.ListBox1.List(Me.ListBox1.ListCount – 1, 7) = b.Cells(i, 8)
Me.ListBox1.List(Me.ListBox1.ListCount – 1, 8) = b.Cells(i, 9)
‘ End If
Next i
‘Carga los datos de la cabecera en listbox
For ii = 0 To 9
UserForm1.ListBox1.List(0, ii) = Sheets(«Articulos»).Cells(1, ii + 1)
Next ii
Exit Sub
End If
b.AutoFilterMode = False
Me.ListBox1.Clear
Me.ListBox1.RowSource = Clear
‘Adiciona un item al listbox reservado para la cabecera
UserForm1.ListBox1.AddItem
For i = 2 To uf
strg = b.Cells(i, 4).Value
If UCase(strg) Like UCase(TextBox2.Value) & «» Then
Me.ListBox1.AddItem b.Cells(i, 1)
Me.ListBox1.List(Me.ListBox1.ListCount – 1, 1) = b.Cells(i, 2)
Me.ListBox1.List(Me.ListBox1.ListCount – 1, 2) = b.Cells(i, 3)
Me.ListBox1.List(Me.ListBox1.ListCount – 1, 3) = b.Cells(i, 4)
Me.ListBox1.List(Me.ListBox1.ListCount – 1, 4) = b.Cells(i, 5)
Me.ListBox1.List(Me.ListBox1.ListCount – 1, 5) = b.Cells(i, 6)
Me.ListBox1.List(Me.ListBox1.ListCount – 1, 6) = b.Cells(i, 7)
Me.ListBox1.List(Me.ListBox1.ListCount – 1, 7) = b.Cells(i, 8)
Me.ListBox1.List(Me.ListBox1.ListCount – 1, 8) = b.Cells(i, 9)
End If
Next i
‘Carga los datos de la cabecera en listbox
For ii = 0 To 9
UserForm1.ListBox1.List(0, ii) = Sheets(«Articulos»).Cells(1, ii + 1)
Next ii
End Sub
Private Sub UserForm_Initialize()
Dim fila As Long
On Error Resume Next
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set b = Sheets(«Articulos»)
uf = b.Range(«A» & Rows.Count).End(xlUp).Row
uc = b.Cells(1, Columns.Count).End(xlToLeft).Address
wc = Mid(uc, InStr(uc, «$») + 1, InStr(2, uc, «$») – 2)
With Me.ListBox1
.ColumnCount = 9
.ColumnWidths = «20 pt;70 pt;180 pt;80 pt;60 pt;60 pt;60 pt;60pt;60pt»
‘.RowSource = «Hoja2!A1:» & wc & uf
End With
‘Adiciona un item al listbox reservado para la cabecera
UserForm1.ListBox1.AddItem
For i = 2 To uf
‘ strg = b.Cells(i, 4).Value
‘If UCase(strg) Like UCase(TextBox2.Value) & «» Then
Me.ListBox1.AddItem b.Cells(i, 1)
Me.ListBox1.List(Me.ListBox1.ListCount – 1, 1) = b.Cells(i, 2)
Me.ListBox1.List(Me.ListBox1.ListCount – 1, 2) = b.Cells(i, 3)
Me.ListBox1.List(Me.ListBox1.ListCount – 1, 3) = b.Cells(i, 4)
Me.ListBox1.List(Me.ListBox1.ListCount – 1, 4) = b.Cells(i, 5)
Me.ListBox1.List(Me.ListBox1.ListCount – 1, 5) = b.Cells(i, 6)
Me.ListBox1.List(Me.ListBox1.ListCount – 1, 6) = b.Cells(i, 7)
Me.ListBox1.List(Me.ListBox1.ListCount – 1, 7) = b.Cells(i, 8)
Me.ListBox1.List(Me.ListBox1.ListCount – 1, 8) = b.Cells(i, 9)
‘ End If
Next i
‘Carga los datos de la cabecera en listbox
For ii = 0 To 9
UserForm1.ListBox1.List(0, ii) = Sheets(«Articulos»).Cells(1, ii + 1)
Next ii
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
On Error GoTo Fin
If CloseMode <> 1 Then Cancel = True
Fin:
End Sub
Código que se inserta en un formulario

Private Sub CommandButton1_Click()
Dim verexi As Object, rutapdf As String, rutaxls As String, rutadir As String, nomfic As String
On Error Resume Next
Application.ScreenUpdating = False
If UserForm2.ListBox1.ListCount = 0 Or TextBox1 = Empty Or TextBox3 = Empty Then
MsgBox «Debe llenar fecha, cliente y seleccionar por lo menos un articulo antes de guardar en la base de datos», vbCritical, «AVISO»
Exit Sub
End If
Set a = Sheets(«DbFac»)
uf = a.Range(«A» & Rows.Count).End(xlUp).Row + 1
For x = 0 To UserForm2.ListBox1.ListCount – 1
a.Cells(uf, «A») = Val(UserForm2.Label2.Caption)
a.Cells(uf, «B») = UserForm2.TextBox3
a.Cells(uf, «C») = UserForm2.Label3.Caption
a.Cells(uf, «D») = UserForm2.TextBox1
a.Cells(uf, «E») = UserForm2.TextBox2
a.Cells(uf, «F») = UserForm2.ListBox1.List(x, 0)
a.Cells(uf, «G») = UserForm2.ListBox1.List(x, 1)
a.Cells(uf, «H») = UserForm2.ListBox1.List(x, 2)
a.Cells(uf, «I») = CDec(UserForm2.ListBox1.List(x, 3))
a.Cells(uf, «J») = CDec(ListBox1.List(x, 5))
uf = uf + 1
Next x
Set b = Sheets(«Factura»)
b.Range(«A9:I24»).ClearContents
b.Range(«H2») = UserForm2.Label2
b.Range(«H3») = UserForm2.TextBox3
b.Range(«B6») = UserForm2.TextBox1
b.Range(«G6») = UserForm2.TextBox2
fila = 9
For x = 0 To UserForm2.ListBox1.ListCount – 1
b.Cells(fila, «A») = UserForm2.ListBox1.List(x, 0)
b.Cells(fila, «B») = UserForm2.ListBox1.List(x, 1)
b.Cells(fila, «E») = UserForm2.ListBox1.List(x, 2)
b.Cells(fila, «F») = CDec(UserForm2.ListBox1.List(x, 3))
b.Cells(fila, «G») = CDec(ListBox1.List(x, 4))
b.Cells(fila, «H») = b.Cells(fila, «F») 0.16
b.Cells(fila, «I») = (b.Cells(fila, «F») * b.Cells(fila, «G»)) * 1.16
fila = fila + 1
Next x
Application.PrintCommunication = True
Sheets(«Factura»).Activate
Sheets(«Factura»).Range(«E60,G60,I60»).NumberFormat = «#,##0.00 «»U$S»»»
With ActiveSheet.PageSetup
.PrintArea = «$A$1:$I$60»
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
Application.PrintCommunication = True
nomfic = UserForm2.Label2 & UserForm2.TextBox3 & UserForm2.TextBox1
nomfic = Replace(nomfic, «/», «»)
rutadir = ActiveWorkbook.Path & «Comprobantes VTA»
rutapdf = rutadir & «» & nomfic & «.pdf»
rutaxls = rutadir & «» & nomfic & «.xlsx»
‘Verifica que la carpeta exista
If Dir(rutadir, vbDirectory) = «» Then
MkDir rutadir
End If
‘Verfica si existe el archivo
Set verexi = CreateObject(«Scripting.FileSystemObject»)
If verexi.FileExists(rutadir) Then
MsgBox («El comprobante de venta ya fue registrado»), vbInformation, «AVISO»
Exit Sub
Else
ActiveSheet.Copy
ActiveWorkbook.SaveAs Filename:=rutaxls, FileFormat:=xlOpenXMLWorkbook
ActiveWorkbook.Close True
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=rutapdf, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=True, OpenAfterPublish:=False
End If
ActiveSheet.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
Sheets(«DbFac»).Select
UserForm2.TextBox1 = Clear
UserForm2.TextBox2 = Clear
UserForm2.TextBox3 = Clear
UserForm2.ListBox1.Clear
UserForm2.Label14 = Clear
UserForm2.Label15 = Clear
UserForm2.Label16 = Clear
uf = Sheets(«DbFac»).Range(«A» & Rows.Count).End(xlUp).Row
Nfac = Application.WorksheetFunction.Max(Sheets(«DbFac»).Range(«A2» & «:A» & uf + 1)) + 1
Label2.Caption = Format(Nfac, «00000000»)
MsgBox «El comprobante de venta se grabó en la base de datos y se guardo en PDF y XLSX», vbCritical, «AVISO»
Application.ScreenUpdating = True
End Sub
Private Sub CommandButton2_Click()
On Error Resume Next
If UserForm2.ListBox1.ListCount = 0 Or TextBox1 = Empty Or TextBox3 = Empty Then
MsgBox «Debe llenar fecha, cliente y seleccionar por lo menos un articulo antes de guardar en la base de datos», vbCritical, «AVISO»
Exit Sub
End If
Set a = Sheets(«DbFac»)
uf = a.Range(«A» & Rows.Count).End(xlUp).Row + 1
For x = 0 To UserForm2.ListBox1.ListCount – 1
a.Cells(uf, «A») = Val(UserForm2.Label2.Caption)
a.Cells(uf, «B») = UserForm2.TextBox3
a.Cells(uf, «C») = UserForm2.Label3.Caption
a.Cells(uf, «D») = UserForm2.TextBox1
a.Cells(uf, «E») = UserForm2.TextBox2
a.Cells(uf, «F») = UserForm2.ListBox1.List(x, 0)
a.Cells(uf, «G») = UserForm2.ListBox1.List(x, 1)
a.Cells(uf, «H») = UserForm2.ListBox1.List(x, 2)
a.Cells(uf, «I») = CDec(UserForm2.ListBox1.List(x, 3))
a.Cells(uf, «J») = CDec(ListBox1.List(x, 5))
uf = uf + 1
Next x
UserForm2.TextBox1 = Clear
UserForm2.TextBox2 = Clear
UserForm2.TextBox3 = Clear
UserForm2.ListBox1.Clear
UserForm2.Label14 = Clear
UserForm2.Label15 = Clear
UserForm2.Label16 = Clear
uf = Sheets(«DbFac»).Range(«A» & Rows.Count).End(xlUp).Row
Nfac = Application.WorksheetFunction.Max(Sheets(«DbFac»).Range(«A2» & «:A» & uf + 1)) + 1
Label2.Caption = Format(Nfac, «00000000»)
End Sub
Private Sub CommandButton3_Click()
UserForm1.Show
End Sub
Private Sub CommandButton4_Click()
Application.ScreenUpdating = True
On Error Resume Next
If UserForm2.ListBox1.ListCount = 0 Or TextBox1 = Empty Or TextBox3 = Empty Then
MsgBox «Debe llenar fecha, cliente y seleccionar por lo menos un articulo antes de guardar en la base de datos», vbCritical, «AVISO»
Exit Sub
End If
Set a = Sheets(«DbFac»)
uf = a.Range(«A» & Rows.Count).End(xlUp).Row + 1
For x = 0 To UserForm2.ListBox1.ListCount – 1
a.Cells(uf, «A») = Val(UserForm2.Label2.Caption)
a.Cells(uf, «B») = UserForm2.TextBox3
a.Cells(uf, «C») = UserForm2.Label3.Caption
a.Cells(uf, «D») = UserForm2.TextBox1
a.Cells(uf, «E») = UserForm2.TextBox2
a.Cells(uf, «F») = UserForm2.ListBox1.List(x, 0)
a.Cells(uf, «G») = UserForm2.ListBox1.List(x, 1)
a.Cells(uf, «H») = UserForm2.ListBox1.List(x, 2)
a.Cells(uf, «I») = CDec(UserForm2.ListBox1.List(x, 3))
a.Cells(uf, «J») = CDec(ListBox1.List(x, 5))
uf = uf + 1
Next x
Set b = Sheets(«Factura»)
b.Range(«A9:I24»).ClearContents
b.Range(«H2») = UserForm2.Label2
b.Range(«H3») = UserForm2.TextBox3
b.Range(«B6») = UserForm2.TextBox1
b.Range(«G6») = UserForm2.TextBox2
fila = 9
For x = 0 To UserForm2.ListBox1.ListCount – 1
b.Cells(fila, «A») = UserForm2.ListBox1.List(x, 0)
b.Cells(fila, «B») = UserForm2.ListBox1.List(x, 1)
b.Cells(fila, «E») = UserForm2.ListBox1.List(x, 2)
b.Cells(fila, «F») = CDec(UserForm2.ListBox1.List(x, 3))
b.Cells(fila, «G») = CDec(ListBox1.List(x, 4))
b.Cells(fila, «H») = b.Cells(fila, «F») * 0.16
b.Cells(fila, «I») = (b.Cells(fila, «F») * b.Cells(fila, «G»)) * 1.16
fila = fila + 1
Next x
UserForm2.TextBox1 = Clear
UserForm2.TextBox2 = Clear
UserForm2.TextBox3 = Clear
UserForm2.ListBox1.Clear
UserForm2.Label14 = Clear
UserForm2.Label15 = Clear
UserForm2.Label16 = Clear
uf = Sheets(«DbFac»).Range(«A» & Rows.Count).End(xlUp).Row
Nfac = Application.WorksheetFunction.Max(Sheets(«DbFac»).Range(«A2» & «:A» & uf + 1)) + 1
Label2.Caption = Format(Nfac, «00000000»)
Application.PrintCommunication = True
Sheets(«Factura»).Activate
Sheets(«Factura»).Range(«E60,G60,I60»).NumberFormat = «#,##0.00 «»U$S»»»
With ActiveSheet.PageSetup
.PrintArea = «$A$1:$I$60»
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
Application.PrintCommunication = True
ActiveSheet.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
Sheets(«DbFac»).Select
MsgBox «El comprobante de venta se guardo e imprimió con éxito», vbCritical, «AVISO»
Application.ScreenUpdating = True
End Sub
Private Sub CommandButton5_Click()
Dim a As Worksheet, b As Worksheet
Dim OApp As Object, OMail As Object, sbdy As String
Dim verexi As Object, rutapdf As String, rutaxls As String, rutadir As String, nomfic As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
If UserForm2.ListBox1.ListCount = 0 Or TextBox1 = Empty Or TextBox3 = Empty Then
MsgBox «Debe llenar fecha, cliente y seleccionar por lo menos un articulo antes de guardar en la base de datos», vbCritical, «AVISO»
Exit Sub
End If
Set a = Sheets(«DbFac»)
uf = a.Range(«A» & Rows.Count).End(xlUp).Row + 1
For x = 0 To UserForm2.ListBox1.ListCount – 1
a.Cells(uf, «A») = Val(UserForm2.Label2.Caption)
a.Cells(uf, «B») = UserForm2.TextBox3
a.Cells(uf, «C») = UserForm2.Label3.Caption
a.Cells(uf, «D») = UserForm2.TextBox1
a.Cells(uf, «E») = UserForm2.TextBox2
a.Cells(uf, «F») = UserForm2.ListBox1.List(x, 0)
a.Cells(uf, «G») = UserForm2.ListBox1.List(x, 1)
a.Cells(uf, «H») = UserForm2.ListBox1.List(x, 2)
a.Cells(uf, «I») = CDec(UserForm2.ListBox1.List(x, 3))
a.Cells(uf, «J») = CDec(ListBox1.List(x, 5))
uf = uf + 1
Next x
Set b = Sheets(«Factura»)
b.Range(«A9:I24»).ClearContents
b.Range(«H2») = UserForm2.Label2
b.Range(«H3») = UserForm2.TextBox3
b.Range(«B6») = UserForm2.TextBox1
b.Range(«G6») = UserForm2.TextBox2
fila = 9
For x = 0 To UserForm2.ListBox1.ListCount – 1
b.Cells(fila, «A») = UserForm2.ListBox1.List(x, 0)
b.Cells(fila, «B») = UserForm2.ListBox1.List(x, 1)
b.Cells(fila, «E») = UserForm2.ListBox1.List(x, 2)
b.Cells(fila, «F») = CDec(UserForm2.ListBox1.List(x, 3))
b.Cells(fila, «G») = CDec(ListBox1.List(x, 4))
b.Cells(fila, «H») = b.Cells(fila, «F») * 0.16
b.Cells(fila, «I») = (b.Cells(fila, «F») * b.Cells(fila, «G»)) * 1.16
fila = fila + 1
Next x
Application.PrintCommunication = True
Sheets(«Factura»).Activate
Sheets(«Factura»).Range(«E60,G60,I60»).NumberFormat = «#,##0.00 «»U$S»»»
With ActiveSheet.PageSetup
.PrintArea = «$A$1:$I$60»
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
Application.PrintCommunication = True
nomfic = UserForm2.Label2 & UserForm2.TextBox3 & UserForm2.TextBox1
nomfic = Replace(nomfic, «/», «»)
rutadir = ActiveWorkbook.Path & «Comprobantes VTA»
rutapdf = rutadir & «» & nomfic & «.pdf»
rutaxls = rutadir & «» & nomfic & «.xlsx»
‘Verifica que la carpeta exista
If Dir(rutadir, vbDirectory) = «» Then
MkDir rutadir
End If
‘Verfica si existe el archivo
Set verexi = CreateObject(«Scripting.FileSystemObject»)
If verexi.FileExists(rutadir) Then
MsgBox («El comprobante de venta ya fue registrado»), vbInformation, «AVISO»
Exit Sub
Else
ActiveSheet.Copy
ActiveWorkbook.SaveAs Filename:=rutaxls, FileFormat:=xlOpenXMLWorkbook
ActiveWorkbook.Close True
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=rutapdf, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=True, OpenAfterPublish:=False
End If
‘Imprime
ActiveSheet.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
‘Envia Mail
Set b = Worksheets(«Factura»)
Asun = «Factura N° » & Val(UserForm2.Label2.Caption) & » de fecha » & UserForm2.TextBox3 & » » & UserForm2.TextBox1
Cop = «»
SCop = «»
busco = UserForm2.TextBox1
Set codigo = Sheets(«Clientes»).Range(«C1:C1000»).Find(busco, LookIn:=xlValues, LookAt:=xlWhole)
If Not codigo Is Nothing Then
uf = codigo.Row
Dest = Sheets(«Clientes»).Cells(uf, «E»)
End If
‘Envia mail
Set OApp = CreateObject(«Outlook.Application»)
Set OMail = OApp.CreateItem(0)
logo = ActiveWorkbook.Path & «Excel.jpg»
sini = «<Div><H3><B>Estimado enviamos factura N° » & Val(UserForm2.Label2.Caption) & » por articulos comprados a nuestra empresa. </B></H3><br></Div>»
‘stbl = TableHTML
spie = «<Div> <IMG SRC=»»» & logo & «»»><B><FONT COLOR= «»red «» >PROGRAMAR EXCEL <a href=»»http://programarexcel.com»»>Visit PROGRAMAR EXCEL.com</a> <a href=»»https://www.youtube.com/channel/UCTKYXi9ljxxOAXXKgwWDDpQ»»>Visit YOUTUBE CHANEL</a> </FONT> <br> Lincoln Road Mall <br> Miami Beach <br> Florida, USA <br> <br>» & _
«Tel: 99999999<br> Fax : 99999999 <br> Whatsapp : 99999999 <br> E -mail: marcrodos@yahoo.es <br><br><FONT COLOR=»» green «»> <FONT FACE= «»Webdings «» >P </FONT> Antes de imprimir este e-mail piense bien si es necesario hacerlo: El medioambiente es cosa de todos !</FONT><br><br>» & _
«* * * * * * * * AVISO DE CONFIDENCIALIDAD * * * * * * * * * * <br><br>Este mensaje de correo electrónico y sus anexos (si los hay) están destinados exclusivamente para el uso del destinatario del mismo, y como tal, siguen siendo propiedad de PROGRAMAR EXCEL.COM. Este mensaje y los archivos adjuntos (si los hay) pueden contener información que es confidencial, privilegiada y exenta de divulgación en virtud de la ley aplicable. Si usted no es el destinatario de este mensaje, se le prohíbe la lectura, divulgación, reproducción, distribución, difusión o utilización de cualquier forma esta transmisión. La entrega de este mensaje a cualquier persona que no sea el destinatario no tiene la intención de renunciar a cualquier derecho o privilegio. Si usted ha recibido este mensaje por error, por favor notifique inmediatamente al remitente por e-mail y elimine de inmediato este mensaje de su sistema.</Div>»
sbdy = sini & vbNewLine & vbNewLine & vbNewLine & vbNewLine & vbNewLine
sbdy = sbdy & vbNewLine & vbNewLine & stbl & vbNewLine & vbNewLine
sbdy = sbdy & spie
With OMail
.To = Dest
.CC = Cop
.BCC = SCop
.Subject = Asun
.Attachments.Add rutapdf
.Display
.HTMLBody = sbdy
.Send
End With
Set OMail = Nothing
Set OApp = Nothing
Sheets(«DbFac»).Select
UserForm2.TextBox1 = Clear
UserForm2.TextBox2 = Clear
UserForm2.TextBox3 = Clear
UserForm2.ListBox1.Clear
UserForm2.Label14 = Clear
UserForm2.Label15 = Clear
UserForm2.Label16 = Clear
uf = Sheets(«DbFac»).Range(«A» & Rows.Count).End(xlUp).Row
Nfac = Application.WorksheetFunction.Max(Sheets(«DbFac»).Range(«A2» & «:A» & uf + 1)) + 1
Label2.Caption = Format(Nfac, «00000000»)
MsgBox «El comprobante de venta se grabó en la base de datos, se guardo en PDF, XLSX y envió por Mail», vbInformation, «AVISO»
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Private Sub CommandButton6_Click()
Unload UserForm2
End Sub
Private Sub Label4_Click()
ActiveWorkbook.FollowHyperlink «https://macrosenexcel.com/p/home.html»
End Sub
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
On Error Resume Next
respuesta = MsgBox(«¿Seguro desea eliminar el dato seleccionado?», vbCritical + vbYesNo)
If respuesta = 6 Then
Set a2 = Sheets(«Articulos»)
filaedit = a2.Range(«A» & Rows.Count).End(xlUp).Row
fila = ListBox1.ListIndex
cod = UserForm2.ListBox1.List(fila, 0)
can = UserForm2.ListBox1.List(fila, 4)
UserForm2.ListBox1.RemoveItem ListBox1.ListIndex
End If
For x = 0 To UserForm2.ListBox1.ListCount – 1
t = CDec(UserForm2.ListBox1.List(x, 6))
tot = tot + t
t = 0
Next x
Set codigo = a2.Range(«B2:B» & filaedit).Find(cod, LookIn:=xlValues, LookAt:=xlWhole)
If Not codigo Is Nothing Then
stodir = codigo.Row
End If
stoold = a2.Cells(stodir, «G»)
a2.Cells(stodir, «G») = stoold + can
can = Empty
cod = Empty
UserForm2.Label16.Caption = «Total » & Format(tot, «#,##0.00;-#.##0,00»)
UserForm2.Label14.Caption = «Subtotal » & Format((tot / 1.16), «#,##0.00;-#.##0,00»)
UserForm2.Label15.Caption = «IVA » & Format(((tot / 1.16) * 0.16), «#,##0.00;-#.##0,00»)
End Sub
Private Sub ListBox2_Click()
On Error Resume Next
ctr = 1
TextBox1 = Empty
TextBox2 = Empty
fila = Me.ListBox2.ListIndex
Me.TextBox1 = ListBox2.List(fila, 2)
Me.TextBox2 = ListBox2.List(fila, 3)
ListBox2.Visible = False
ctr = 0
End Sub
Private Sub TextBox1_AfterUpdate()
creg = ListBox2.ListCount
If creg = 0 Then
ListBox2.Visible = False
RESP = MsgBox(«Presione SI para cargar cliente o NO para cancelar y proseguir la realización del comprobante de venta», vbYesNo, «REQUIERE CARGAR EL CLIENTE NUEVO»)
If RESP = 6 Then
uf = Sheets(«Clientes»).Range(«A» & Rows.Count).End(xlUp).Row
UserForm4.TextBox1 = Application.WorksheetFunction.Max(Sheets(«Clientes»).Range(«A2» & «:A» & uf + 1)) + 1
UserForm4.TextBox3 = UserForm2.TextBox1
UserForm4.TextBox2.SetFocus
UserForm4.Show
Else
UserForm2.TextBox2.Locked = False
UserForm2.TextBox2 = Empty
UserForm2.TextBox2.SetFocus
End If
End If
End Sub
Private Sub TextBox1_Change()
If ctr = 1 Then Exit Sub
On Error Resume Next
Set b = Sheets(«Clientes»)
uf = b.Range(«A» & Rows.Count).End(xlUp).Row
If Trim(TextBox1.Value) = «» Then
Me.ListBox2.RowSource = «Clientes!A2:D» & uf
Exit Sub
End If
b.AutoFilterMode = False
Me.ListBox2.Clear
Me.ListBox2.RowSource = Clear
Me.ListBox2.ColumnCount = 4
For i = 2 To uf
strg = b.Cells(i, 3).Value
If UCase(strg) Like «» & UCase(TextBox1.Value) & «» Then
Me.ListBox2.AddItem b.Cells(i, 1)
Me.ListBox2.List(Me.ListBox2.ListCount – 1, 1) = b.Cells(i, 2)
Me.ListBox2.List(Me.ListBox2.ListCount – 1, 2) = b.Cells(i, 3)
Me.ListBox2.List(Me.ListBox2.ListCount – 1, 3) = b.Cells(i, 4)
End If
Next i
Me.ListBox2.ColumnWidths = «20 pt;50 pt;80 pt;80»
ListBox2.Visible = True
End Sub
Private Sub UserForm_Initialize()
uf = Sheets(«DbFac»).Range(«A» & Rows.Count).End(xlUp).Row
Nfac = Application.WorksheetFunction.Max(Sheets(«DbFac»).Range(«A2» & «:A» & uf + 1)) + 1
Label2.Caption = Format(Nfac, «00000000»)
Me.ListBox1.ColumnCount = 7
Me.ListBox1.ColumnWidths = «70 pt;150 pt;60 pt;60 pt;60 pt;60 pt;60 pt»
TextBox3.SetFocus
End Sub
Código que se inserta en un formulario

Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
On Error Resume Next
Dim t As Variant, tot As Variant
If UserForm3.TextBox1 = Empty Or UserForm3.TextBox1 = 0 Then Exit Sub
If UserForm2.ListBox1.ListCount > 50 Then
MsgBox («No puede ingresar más de 16 articulos por factura»), vbCritical, «AVISO»
Exit Sub
End If
Set a1 = Sheets(«Articulos»)
If KeyCode = 13 Then
can = Val(UserForm3.TextBox1)
UserForm2.ListBox1.AddItem cod
UserForm2.ListBox1.List(UserForm2.ListBox1.ListCount – 1, 1) = art
UserForm2.ListBox1.List(UserForm2.ListBox1.ListCount – 1, 2) = mar
UserForm2.ListBox1.List(UserForm2.ListBox1.ListCount – 1, 3) = Format(pv, «#,##0.0000;-#.##0,0000»)
UserForm2.ListBox1.List(UserForm2.ListBox1.ListCount – 1, 4) = Format(can, «#,##0.00;-#.##0,00»)
UserForm2.ListBox1.List(UserForm2.ListBox1.ListCount – 1, 5) = Format((pv * 0.16), «#,##0.00;-#.##0,00»)
UserForm2.ListBox1.List(UserForm2.ListBox1.ListCount – 1, 6) = Format(((can * pv) * 1.16), «#,##0.00;-#.##0,00»)
Unload UserForm3
For x = 0 To UserForm2.ListBox1.ListCount – 1
t = CDec(UserForm2.ListBox1.List(x, 6))
tot = tot + t
t = 0
Next x
UserForm2.Label16.Caption = «Total » & Format(tot, «#,##0.00 «»U$S»»»)
UserForm2.Label14.Caption = «Subtotal » & Format((tot / 1.16), «#,##0.00 «»U$S»»»)
UserForm2.Label15.Caption = «IVA » & Format(((tot / 1.16) * 0.16), «#,##0.00 «»U$S»»»)
stoold = a1.Cells(stodir, «G»)
a1.Cells(stodir, «G») = a1.Cells(stodir, «G») – can
End If
End Sub
Código que se inserta en un formulario

Private Sub CommandButton1_Click()
If UserForm4.TextBox1 = Empty Or UserForm4.TextBox2 = Empty Or UserForm4.TextBox3 = Empty Or UserForm4.TextBox4 = Empty Then Exit Sub
Set a = Sheets(«Clientes»)
uf = a.Range(«A» & Rows.Count).End(xlUp).Row + 1
a.Cells(uf, «A») = Val(UserForm4.TextBox1)
a.Cells(uf, «B») = UserForm4.TextBox2
a.Cells(uf, «C») = UserForm4.TextBox3
a.Cells(uf, «D») = UserForm4.TextBox4
a.Cells(uf, «E») = UserForm4.TextBox5
UserForm2.TextBox1 = UserForm4.TextBox3
UserForm2.TextBox2 = UserForm4.TextBox4
MsgBox («Los datos se gaurdarón con éxito»), vbInformation, «AVISO»
Unload UserForm4
End Sub
Private Sub CommandButton2_Click()
Unload UserForm4
End Sub

Si te fue de utilidad puedes INVITARME UN CAFÉ y de esta manera ayudar a seguir manteniendo la página, CLICK para descargar en ejemplo en forma gratuita.

If this post was helpful INVITE ME A COFFEE and so help keep up the page, CLICK to download free example.

Si te gustó por favor compártelo con tus amigos
If you liked please share it with your friends