Como crear una factura o sale invoice y grabar guardar PDF XLS y enviar por mail

Este iba a ser el último de la saga de ocho post dedicados a mostrar como se puede crear una factura de venta, comprobante de venta o sale invoice en Excel a través de un formulario, usando textbox y listbox para facilitar la carga o introducción de dato, pero a pedido de un suscriptor se agregará otro post más y estará relacionado con el stock, es decir mostrará como vender o facturar y automáticamente descontar lo vendido del stock con macro, así que suscriban (YouTube, Suscribir a Web)para no perderse este ejemplo y muchos más que se publican constantemente.

En este ejemplo de macro específicamente se verá como enviar por mail la factura o sale invoice generada, usando Excel a través de Outlook, adjuntando PDF de la factura y una imagen en el cuerpo del mensaje que tenemos en nuestra PC , además de una firma al pie del mail, suena bastante interesante verdad.

Con el fines de evitar a ustedes pérdida de tiempo buscando los post anteriores relacionados con la creación de una Factura de Venta en Excel,los listo a todos seguidamente, sugiero verlos para entender en su totalidad el ejemplo:

Si te estás iniciando en la operación de Excel o requieres afirmar conocimientos, 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.

Desde el link que está al final de la página podrán descargar en forma GRATUITA el ejemplo de macro denominado como crear una factura de venta guardar y enviar por mail, al descargar el ejemplo se podrá observar un archivo comprimido que contiene la macro y un archivo jpg que se usará como imagen para enviar en el cuerpo del mensaje, se debe guardar en cualquier lugar de la PC con la condición que se guarde junto con el archivo que contiene la macro; al abrir el Excel se verá un botón que permite mostrar el formulario para generar la factura.

Este formulario contiene todas las funcionalidades para poder seleccionar clientes, crear uno nuevo si es necesario, cargar artículos al comprobante de venta, guardar en la base de datos, imprimir si es necesario, guardarlo en PDF si es requerido y la última funcionalidad que es poder enviar la factura creada por mail que se explica en este post.

Una vez cargado los datos y estando la factura lista en condiciones de ser guardada, se debe presionar el botón con el símbolo de @, ello permite en un primer momento, validad que se hayan ingresado fecha, cliente y por lo menos un articulo, pasada esta validación; guarda los datos en la base de datos, generando un archivo PDF con la factura en la carpeta destinada a guardar PDF, luego procede a enviar el mail, adjuntando el PFD creado y con un breve texto que contiene una imagen existente en la PC, puede ser la descargada con esta macro o cualquiera que cuyo nombre debe ser Excel.jpg y estar en el mismo directorio donde esta el archivo con la macro.

Centrándonos en el envío de mail específicamente se puede observar que el código es el siguiente:

‘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

Como se observa y a diferencia de como de había envíado mail con Excel en otros ejemplos publicados en esta web, se apela al HTML, por lo que si se conoce algo mínimo de este lenguaje sería mucho mejor, sino no es problema, porque se puede adaptar el ejemplo y listo.

Lo que se hace es agregar una cadena de texto con el código html a las tres variables creadas que son:

sini: en esta variable se carga la cadena de text que va al comienzo del mail en este ejemplo la cadena de texto es «Estimado enviamos factura N° » (Número de Factura Generada) » por articulos comprados a nuestra empresa.

stbl: se usa para cargar una tabla de Excel en el cuerpo del mensaje, en este caso está comentada, no se usa, si les interesa el tema pueden buscar un ejemplo en https://macrosenexcel.com/p/home.html.

spie: en esta variable se establece la cadena o string con el pie del mail, en este ejemplo se incorporó la imagen también a modo de logo de la empresa, pero se puede incorporar en el inicio, en este ejemplo se incorporó en el pie, para buscar otros ejemplos sobre envío de mail con imagen en el cuerpo del mensaje, echar un vistazo a https://macrosenexcel.com/p/home.html.

Detengámonos en el pie que es donde se incorpora la imagen, el string o cadena es la siguiente:

Y el resultado que se verá en pantalla es:

Luego de creadas las cadenas de texto que formarán el mail se van concatenando en una sola variable denominada stby, agregando líneas en blanco (vbNewLine) entre las distintas cadena de texto, eso se hace de la siguiente manera:

sbdy = sini & vbNewLine & vbNewLine & vbNewLine & vbNewLine & vbNewLine

sbdy = sbdy & vbNewLine & vbNewLine & stbl & vbNewLine & vbNewLine

sbdy = sbdy & spie

Una vez que se tiene la cadena de texto en la variable sbdy se agrega en el cuerpo del mensaje del objeto creado con el mail, posteriormente se envía de la siguiente forma:

.HTMLBody = sbdy
.Send

El vídeo que sigue muestra la macro en acción y complemente la explicación, sugiero que lo veas con atención teniendo el ejemplo a la vista; 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 cargar datos sin duplicar, buscar en listbox mientras escribes en textbox, como enviar mail en el cuerpo del mensaje con PDF adjunto, conectar Excel con Access, como abrir modificar e imprimir archivos de Word desde Excel 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
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
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 = «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
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
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