PROGRAMAR EN VBA MACROS PARA EXCEL: Como Filtrar por Cliente Rango de Fechas y Exportar a PDF

Como Filtrar por Cliente Rango de Fechas y Exportar a PDF






En este ejemplo se mostrará Como Filtrar Datos por Cliente y/o Rango de Fechas y Exportar Datos a PDF, es decir en el formulario se podrá filtrar datos por clientes o rango de fechas o también por cliente y luego sumarle al filtro que se seleccione los datos entre una fecha inicial y una final, obtenidos los datos se cargarán en el listbox pudiendo luego con los datos que están filtrados y fueron mostrados en el listbox exportarlos a PDF.

Si estás trabajando con listbox quizás quieras aprender más sobre este objeto de VBA para Excel, en el link encontrarás muchos ejemplos que serán de utilidad relacionados con listbox de Excel.

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.

  

Suscribe a nuestro canal para que YouTube te avise cuando se suba nuevo contenido al canal, en el vídeo encontrarás una explicación gráfica y detallada del ejemplo que se muestra en este post.







 


Sugiero descargar el ejemplo para que sea más fácil de comprender, resumiendo la macro contenida en el formulario de Excel y en los botones insertos, permiten realizar filtros por cliente que también puede ser proveedor, una marca o cualquier dato, cada uno lo puede adaptar.

Al filtro por cliente si se quiere se puede adicionar un filtro por un rango de fechas, estos datos obtenidos se mostrarán en el Listbox inserto en el formulario , existiendo un botón que permite Exportar los datos filtrados a PDF.

La macro que filtra por cliente y rango de fechas se puede consultar en el siguiente link, una de ellas hay varios ejemplos los cuales se pueden encontrar en el siguiente playlist Listbox de Excel.

En este post nos vamos a detener en mostrar como se puede exportar a PDF los datos ya filtrados, ya que como se hace el filtro por fecha y cliente ya fue explicado anteriormente, la macro para exportar a PDF se encuentre en el CommandButton4, que en el formulario tiene un icono con imagen que dice PDF.

Para lograr lo mencionado se procederá a crear una hoja temporal de Excel, primero en caso que exista se borra la hoja luego se inserta una una y se le asigna nombre creando un objeto con dicha hoja, con los siguientes códigos:

Sheets("DFSHJFDUYDAYRAIUY544TTTOMYDUTGD").Delete
ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = "DFSHJFDUYDAYRAIUY544TTTOMYDUTGD"
Set a = Sheets("DFSHJFDUYDAYRAIUY544TTTOMYDUTGD")

Luego se copian todos los datos filtrados que se están mostrando en el Userform en la hoja temporal que se ha creado, para ello se realiza un bucle entre la primer y ultima fila del listbox, pasando los datos a la hoja temporal, apelando a los siguientes códigos:

For x = 1 To UserForm1.ListBox1.ListCount - 5
a.Cells(x + 2, "A") = ListBox1.List(x, 0)
a.Cells(x + 2, "B") = CDate(ListBox1.List(x, 1))
a.Cells(x + 2, "C") = ListBox1.List(x, 2)
a.Cells(x + 2, "D") = ListBox1.List(x, 3)
a.Cells(x + 2, "E") = ListBox1.List(x, 4)
a.Cells(x + 2, "F") = ListBox1.List(x, 5)
a.Cells(x + 2, "G") = CDec(ListBox1.List(x, 6))
Next


⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛
Quizá sea de utilidad también

Como filtrar datos llenar listbox de más de diez columnas


Como enviar mail con archivo Excel y PDF mediante Outlook con Excel

Como agregar menu ayuda en iconos personalizados barra Ribbon o Cinta Opciones Excel


Posteriormente se de la un formato al informe, le he dado ancho de columnas, formato fecha, ajuste a una pagina de alto y ancho, etc, cada uno dará el formato que necesite en su proyecto, he aplicado los siguientes códigos:

With a.Range("A1:G1")
.Merge 'Combinación celdas A a G
.VerticalAlignment = xlCenter 'Alineación Vertical Centrada
.HorizontalAlignment = xlCenter 'Alineación Horizontal Centrada
.RowHeight = 20 'Alto Fila
.Font.Size = 16 'Tamaño Fuente
End With

a.Range("A2") = "CLIENTE"  'Crea los encabezados de las columnas
a.Range("B2") = "FECHA"
a.Range("C2") = "COMPROBANTE"
a.Range("D2") = "TIPO"
a.Range("E2") = "SUC"
a.Range("F2") = "N COMP"
a.Range("G2") = "IMPORTE"
uf = a.Range("G" & Rows.Count).End(xlUp).Row
a.Range("G2:G" & uf).NumberFormat = "#.#,0"  'formato númerico con dos decimales
a.Range("B2:B" & uf).NumberFormat = "dd/mm/yyyy" 'formato fecha ejemplo 12/06/2014
a.Range("A:G").Columns.AutoFit 'Ajuste automático de la columna al texto
a.Range("A:A").ColumnWidth = 31 'Ancho de columna
Application.PrintCommunication = True
With ActiveSheet.PageSetup
.PrintArea = "$A$1:$G$" & uf + 4 'Crea área de impresión
.FitToPagesWide = 1   'Ajuste de alto y ancho de páginas
.FitToPagesTall = 1
End With

Luego la macro procede a crear el nombre con el que se guardará el fichero PDF, tomando el nombre del archivo que contiene la macro más la extensión PDG, así:

nom = ActiveWorkbook.Name
pto = InStr(nom, ".")
nomarch = Left(nom, pto - 1)
'nomarch = nomarch & ".pdf"
myfile = ThisWorkbook.Path & "\" & nomarch

El paso siguiente es exportar a PDF con el siguiente código:

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

Por último borra la hoja temporal y sale un mensaje avisando de la exportación de los datos a un archivo a PDF, con la siguiente codificación:

a.Delete 'Es para borrar la hoja temporar creada
Sheets("Hoja1").Select 'selecciona la hoja 1
MsgBox "El reporte se exportó a PDF con éxito", vbCritical, "AVISO" 'emite aviso

Con esto damos por finalizada la explicación del ejemplo que permite Filtrar por Cliente Rango de Fechas y Exportar a PDF los Datos Filtrados, a continuación la codificación completa y posteriormente el link de descar de ejemplo que es como siempre absolutamente gratis.


Código que se inserta en un Formulario de Excel

'**************https://programarexcel.com  **** https://youtube.com/programarexcel*********



Private Sub CommandButton1_Click()
Unload Me
End Sub

Private Sub CommandButton2_Click()
On Error Resume Next
Set b = Sheets("Hoja1")
uf = b.Range("A" & Rows.Count).End(xlUp).Row
dato1 = CDate(TextBox2)
dato2 = CDate(TextBox3)
If dato2 = Empty Or dato1 = emtpy Then
MsgBox ("Debe ingresar datos para consulta entre rango de fechas"), vbCritical, "AVISO"
Exit Sub
End If
If dato2 < dato1 Then
MsgBox ("La fecha final no puede ser mayor a la fecha inicial"), vbCritical, "AVISO"
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

If dato1 = Empty Or dato2 = Empty Then

For i = 2 To uf
   dato0 = CDate(b.Cells(i, 2).Value)
   If dato0 >= dato1 And dato0 <= dato2 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)
   End If
Next i


Else

If dato2 < dato1 Then
MsgBox ("La fecha final no puede ser mayor a la fecha inicial"), vbCritical, "AVISO"
Exit Sub
End If

For i = 2 To uf
   strg = b.Cells(i, 1).Value
   dato0 = CDate(b.Cells(i, 2).Value)
   If UCase(strg) Like UCase(TextBox1.Value) & "*" And dato0 >= dato1 And dato0 <= dato2 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)
   End If
Next i

End If


'Carga los datos de la cabecera en listbox
For ii = 0 To 7
UserForm1.ListBox1.List(0, ii) = Sheets("Hoja1").Cells(1, ii + 1)
Next ii

UserForm1.ListBox1.AddItem
UserForm1.ListBox1.AddItem
UserForm1.ListBox1.AddItem
UserForm1.ListBox1.List(UserForm1.ListBox1.ListCount - 1, 0) = "Total Importe"

For x = 0 To UserForm1.ListBox1.ListCount - 1
t = CDec(UserForm1.ListBox1.List(x, 6))
tot = tot + t
t = 0
Next x
UserForm1.ListBox1.List(UserForm1.ListBox1.ListCount - 1, 1) = Format(tot, " ""U$S"" #,##0.00 ")

UserForm1.ListBox1.AddItem
UserForm1.ListBox1.List(UserForm1.ListBox1.ListCount - 1, 0) = "Total de registros:"
UserForm1.ListBox1.List(UserForm1.ListBox1.ListCount - 1, 1) = UserForm1.ListBox1.ListCount - 5

Me.ListBox1.ColumnWidths = "170 pt;70 pt;50 pt;50 pt;50 pt;50 pt;50 pt"
End Sub

Private Sub CommandButton3_Click()
Unload UserForm1
End Sub

Private Sub CommandButton4_Click()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next

'Elimina hoja y crea hoja dando el mismo nombre que la eliminada
Sheets("DFSHJFDUYDAYRAIUY544TTTOMYDUTGD").Delete
ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = "DFSHJFDUYDAYRAIUY544TTTOMYDUTGD"
Set a = Sheets("DFSHJFDUYDAYRAIUY544TTTOMYDUTGD")

For x = 1 To UserForm1.ListBox1.ListCount - 5
a.Cells(x + 2, "A") = ListBox1.List(x, 0)
a.Cells(x + 2, "B") = CDate(ListBox1.List(x, 1))
a.Cells(x + 2, "C") = ListBox1.List(x, 2)
a.Cells(x + 2, "D") = ListBox1.List(x, 3)
a.Cells(x + 2, "E") = ListBox1.List(x, 4)
a.Cells(x + 2, "F") = ListBox1.List(x, 5)
a.Cells(x + 2, "G") = CDec(ListBox1.List(x, 6))
Next

a.Cells(x + 4, "A") = ListBox1.List(x + 2, 0)
a.Cells(x + 5, "A") = ListBox1.List(x + 3, 0)
a.Cells(x + 4, "B") = ListBox1.List(x + 2, 1)
a.Cells(x + 5, "B") = ListBox1.List(x + 3, 1)

a.Activate
a.Range("A1") = "REPORTE DE VENTAS"

With a.Range("A1:G1")
.Merge
.VerticalAlignment = xlCenter
.HorizontalAlignment = xlCenter
.RowHeight = 20
.Font.Size = 16
End With

a.Range("A2") = "CLIENTE"
a.Range("B2") = "FECHA"
a.Range("C2") = "COMPROBANTE"
a.Range("D2") = "TIPO"
a.Range("E2") = "SUC"
a.Range("F2") = "N COMP"
a.Range("G2") = "IMPORTE"
uf = a.Range("G" & Rows.Count).End(xlUp).Row
a.Range("G2:G" & uf).NumberFormat = "#.#,0"
a.Range("B2:B" & uf).NumberFormat = "dd/mm/yyyy"
a.Range("A:G").Columns.AutoFit
a.Range("A:A").ColumnWidth = 31
Application.PrintCommunication = True
With ActiveSheet.PageSetup
.PrintArea = "$A$1:$G$" & uf + 4
.FitToPagesWide = 1
.FitToPagesTall = 1
End With


nom = ActiveWorkbook.Name
pto = InStr(nom, ".")
nomarch = Left(nom, pto - 1)
'nomarch = nomarch & ".pdf"
myfile = ThisWorkbook.Path & "\" & nomarch

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

a.Delete
Sheets("Hoja1").Select
MsgBox "El reporte se exportó a PDF con éxito", vbCritical, "AVISO"
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Private Sub TextBox1_Change()
On Error Resume Next
Set b = Sheets("Hoja1")
uf = b.Range("A" & Rows.Count).End(xlUp).Row
If Trim(TextBox1.Value) = "" Then
   Me.ListBox1.RowSource = "Hoja1!A1:G" & uf
   Exit Sub
End If


b.AutoFilterMode = False
Me.ListBox1 = Clear
Me.ListBox1.RowSource = Clear
dato1 = CDate(TextBox2)
dato2 = CDate(TextBox3)
'Adiciona un item al listbox reservado para la cabecera
UserForm1.ListBox1.AddItem


For i = 2 To uf
   strg = b.Cells(i, 1).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)
   End If
Next i



'Carga los datos de la cabecera en listbox
For ii = 0 To 7
UserForm1.ListBox1.List(0, ii) = Sheets("Hoja1").Cells(1, ii + 1)
Next ii


UserForm1.ListBox1.AddItem
UserForm1.ListBox1.AddItem
UserForm1.ListBox1.AddItem
UserForm1.ListBox1.List(UserForm1.ListBox1.ListCount - 1, 0) = "Total Importe"

For x = 0 To UserForm1.ListBox1.ListCount - 1
t = CDec(UserForm1.ListBox1.List(x, 6))
tot = tot + t
t = 0
Next x
UserForm1.ListBox1.List(UserForm1.ListBox1.ListCount - 1, 1) = Format(tot, " ""U$S"" #,##0.00 ")

UserForm1.ListBox1.AddItem
UserForm1.ListBox1.List(UserForm1.ListBox1.ListCount - 1, 0) = "Total de registros:"
UserForm1.ListBox1.List(UserForm1.ListBox1.ListCount - 1, 1) = UserForm1.ListBox1.ListCount - 5


UserForm1.TextBox2 = Clear
UserForm1.TextBox3 = Clear

Me.ListBox1.ColumnWidths = "170 pt;70 pt;50 pt;50 pt;50 pt;50 pt;50 pt"
End Sub

Private Sub TextBox2_Change()
If Len(UserForm1.TextBox2) = 10 Then UserForm1.TextBox3.SetFocus
End Sub

Private Sub TextBox3_Change()
If Len(UserForm1.TextBox3) = 10 Then UserForm1.CommandButton2.SetFocus
End Sub

Private Sub UserForm_Initialize()
Dim fila As Long
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set b = Sheets("Hoja1")
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 = 7
    .ColumnWidths = "170 pt;50 pt;50 pt;50 pt;50 pt;50 pt;50 pt"
    .RowSource = "Hoja1!A1:" & wc & uf
End With
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 módulo

'**************https://programarexcel.com  **** https://youtube.com/programarexcel*********

#If VBA7 And Win64 Then

'Si es de 64 bits

Public Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As LongPtr, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As LongPtr

Public Declare PtrSafe Function FindWindow Lib "USER32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr

Public Declare PtrSafe Function GetWindowLongPtr Lib "USER32" Alias "GetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr

Public Declare PtrSafe Function SetWindowLongPtr Lib "USER32" Alias "SetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr

Public Declare PtrSafe Function DrawMenuBar Lib "USER32" (ByVal hwnd As Long) As LongPtr

Public Declare PtrSafe Function RegOpenKeyA Lib "advapire32.dll" (ByVal hKey As LongPtr, ByVal lpSubKey As String, phkResult As LongPtr) As LongPtr

#Else

'Si es de 32 bits

Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Public Declare Function FindWindow Lib "USER32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Public Declare Function GetWindowLong Lib "USER32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long

Public Declare Function SetWindowLong Lib "USER32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Public Declare Function DrawMenuBar Lib "USER32" (ByVal hwnd As Long) As Long

Public Declare Function RegOpenKeyA Lib "advapire32.dll" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long

#End If

Sub muestra1()

UserForm1.Show

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