Como crear una factura o sale invoice y guardar en PDF

Hoy hablaremos sobre como guardar un archivo en PDF, recuerden que a lo largo de estos 7 vídeos que tratan sobre como crear una factura o sale invoice con un formulario de VBA, listbox y textbox; se mostró como seleccionar clientes de un listbox y pasar datos a textbox, como pasar items con enter de listbox a otro listbox, eliminar registros de un listbox, guardar la factura genrada, imprimir la factura o sale invoice; siendo necesario en muchas veces guardar la factura en PDF para enviarla en forma por mail.

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.

Para poder guardar en PDF se necesita apelar al siguiente código, básicamente lo que hacer es tomar el archivo y guardarlo como PDF siendo una de las opciones que da Excel para guardar un archivo, es decir que con el código siguiente se puede guardar en PDF solo se debe modificar File name, y poner el nombre del archivo de cada uno.

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=rutapdf, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=True, OpenAfterPublish:=False

Previo a guardar en PDF la macro determina si una carpeta existe en caso negativo la crea, si existe guarda dentro de ella el archivo generado en PDF, este ejemplo guarda ademas una copia en la misma carpeta como archivo de Excel Xlsx.

Como se dijo primero se verifica si el directorio existe, caso contrario lo crea; eso se hace con el siguiente código:

If Dir(rutadir, vbDirectory) = «» Then
MkDir rutadir
End If

Determinada la existencia del directorio y en caso positivo verifica la existencia del archivo en caso de que exista no hace nada ya que la factura esta generada y a los fines de evitar duplicado

‘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

En caso que el archivo no exista que es lo más probable porque el sistema no deja grabar Facturas por Ventas o Sale Invoice en forma duplicada, procede a guardar el archivo como PDF con el siguiente código.

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

Desde el final del post se encuentra un link para poder descargar el archivo, lo cual recomiendo, el mismo no tiene ningún tipo de restricción siendo su uso gratuito.

El vídeo que sigue muestra una explicación más detallada y gráfica de la macro presentada, recomiendo observar para una más fácil comprensión de 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 formulario que crea un listado de todas las hojas para poder luego seleccionarlas, buscar en listbox mientras escribes en textbox, ordenar hojas libro excel por su nombre, conectar Excel con Access 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
Sub muestra()
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 + 1
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)
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
a.Activate
UserForm2.TextBox1 = Clear
UserForm2.TextBox2 = Clear
UserForm2.TextBox3 = Clear
UserForm2.ListBox1.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
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 = 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
UserForm2.TextBox1 = Clear
UserForm2.TextBox2 = Clear
UserForm2.TextBox3 = Clear
UserForm2.ListBox1.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
a.Activate
MsgBox «El comprobante de venta se guardo e imprimió con éxito», vbCritical, «AVISO»
Application.ScreenUpdating = True
End Sub
Private Sub CommandButton5_Click()
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
fila = ListBox1.ListIndex
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
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 = «15 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
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»»»)
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
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