Saltar al contenido
PROGRAMAR EN VBA MACROS DE EXCEL
Listbox de Excel

Como Filtrar por Cliente Rango de Fechas y Exportar a WORD


.

En este post se muestra una como Filtrar por Cliente y Rango de Fechas y luego Exportar lo Filtrado a Word con una macro de Excel, es decir que la macro permite que se filtre por cliente si se requiere se puede adicionar un filtro por fecha, esos datos se mostrarán en un Listbox, luego presionando un botón se exportarán los datos del Listbox a un archivo de Word.

Este es otro vídeo más de la saga de vídeos que tratan el tema o muestran como Conectar Excel con Word, en el siguiente play list podrás ver el resto de vídeos relacionados con el correspondiente link para descarga del 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.

  
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.


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);
}
}

  
El ejemplo contenido en el libro de Excel que se puede descargar desde el final del post, al iniciar se puede observar botón que presionándolo muestra un formulario con textbox para búsquedas un listbox donde se mostrarán los datos filtrados y botón para filtrar por rango de datos y lo que nos importa en este ejemplo un botón para exportar los datos filtrados a Word.

Insertando los tres primeros caracteres la macro comenzará a buscar en la base de datos de Clientes que está en la Hoja1, mostrando en el listbox todas las coincidencias que haya en la base de datos ministras se va escribiendo en el textbox, al filtro se le puede adicionar un filtro por rango de fechas, es decir primero se podrá filtrar por cliente y los registros relacionados con el cliente se le puede agregar otro filtro más por rango de fechas.

Las fechas tanto de inicio como de fin del rango se deben ingresar y luego presionar el botón destinado a aplicar un filtro por fecha desde fecha hasta, eso se hace con el primer botón que tiene como imagen un lupa, procediendo a mostrar en el listbox los datos filtrados o coincidentes con los criterios de búsqueda.

Una vez que se tienen los datos requeridos de acuerdo al filtro, presionando el botón exportar a Word, que tiene una imagen icono de Word, se pasan todos los datos filtrados y mostrados en el listbox a un archivo de Word mediante una macro.

Para logar pasar dos datos del Listbox de Excel a Word, se trabajará con una hoja temporal, para poder pasar los datos del listbox a una hoja de Excel, eso se realiza con el siguiente código

Sheets(«DFSHJFDUYDAYRAIUY544TTTOMYDUTGD»).Delete
ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = «DFSHJFDUYDAYRAIUY544TTTOMYDUTGD»

Luego se empiezan a pasar todos los datos del listbox que son los coincidentes con el filtro de datos requerido a la hoja temporal de Excel eso se realiza con la codificación que se muestra a continuación:

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 Copiar un Gráfico de Excel a Word

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

Como buscar datos en Excel con el método Find

Posteriormente se da un poco de formato al informe, ya que se supone que lo que se requiere es crear un informe o reporte de Ventas del Cliente, desde ya esto puede servir para cualquier reporte que se requiera crear, solo basta adaptar un poco, algunos de los códigos usados son los siguientes;

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

El primero da a la celdas formato de número con separador de miles y dos decimales, el segundo código da formato de fecha, el tercer código establece que las columnas se expandan en forma automática de acuerdo al texto contenido en la celta y el cuarto código da un ancho de columna determinado.

Una vez que esté listo el informe en la hoja de Excel la macro determina el nombre con el que va a Guardar el archivo de Word, en este caso se guardará con el mismo nombre de la macro se usan los siguientes códigos:

nom = ActiveWorkbook.Name
pto = InStr(nom, «.»)
nomarch = Left(nom, pto – 1)
ruta = ThisWorkbook.Path & «» & nomarch & «.docx

Posteriormente se agrega un documento Word cuyo nombre es el determinado anteriormente:

Set wdDoc = objWord.Documents.Add
nomfic = nomarch & » » & Format(Date, «dd-mm-yyyy»)
rutainf = ThisWorkbook.Path & «» & nomfic & «.docx»

Seguidamente empieza a pasar los datos de Excel a Word como: primero la macro crea un marcador en Word que le indique a donde se debe pegar la tabla de Excel, para ello tipea el nombre del marcador agregando dos párrafos, es como si se estuviera escribiendo directamente en Word, con los siguientes códigos:

tj = «[Tabla1]»
objWord.Selection.TypeParagraph
objWord.Selection.TypeParagraph
objWord.Selection.TypeText Text:=tj

Luego con el método find la macro va a buscar donde está el marcador escribo en Word y lo reemplazará con la tabla que previamente ha copiado de Excel, así:

a.Range(«A1:» & wc & uf).Copy

ts = «[Tabla1]»
objWord.Selection.Move 6, -1
objWord.Selection.Find.Execute FindText:=ts
While objWord.Selection.Find.Found = True
objWord.Selection.PasteExcelTable False, True, False
objWord.Selection.Move 6, -1
objWord.Selection.Find.Execute FindText:=ts
Wend

Ya se han copiado los datos, en este caso una tabla de Excel a Word, ahora en Word se le va a dar formato tomando uno de los formatos que tiene estandarizados Word para las tablas,con el siguiente código:

For Each tabla In objWord.ActiveDocument.Tables
tabla.Style = «Tabla con cuadrícula 2 – Énfasis 1»
tabla.AutoFitBehavior wdAutoFitWindow
With objWord.ActiveDocument.Styles(«Tabla con cuadrícula 2 – Énfasis 1»).Font
 .Size = 8
 .Color = wdColorAutomatic
End With
Next

Por último Guarda el documento de Word y lo cierra, elimina la hoja temporal, sale un mensaje de finalización de la macro y está termina, logrando con macro de Excel Filtrar por Cliente por un Lapso de Fechas y Mostrando en Lsitbox el Filtro y Exportando lo Filtrado a Word.

Seguidamente el código completo y a continuación el link de descarga, sugiero descargar el archivo y ver el vídeo para una comprensión más fácil.

Código que se inserta en un Formulario de Excel

‘**************https://macrosenexcel.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()
Dim objWord As Word.Application, wdDoc As Word.Document
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)
ruta = ThisWorkbook.Path & «» & nomarch & «.docx»
Set objWord = CreateObject(«Word.Application»)
objWord.DisplayAlerts = wdAlertsNone
‘objWord.Visible = True
Set wdDoc = objWord.Documents.Add
nomfic = nomarch & » » & Format(Date, «dd-mm-yyyy»)
rutainf = ThisWorkbook.Path & «» & nomfic & «.docx»

tj = «[Tabla1]»
objWord.Selection.TypeParagraph
objWord.Selection.TypeParagraph
objWord.Selection.TypeText Text:=tj

uf = a.Range(«A» & pf).End(xlDown).Row
uc = a.Range(«A1»).End(xlToRight).Address
wc = Mid(uc, InStr(uc, «$») + 1, InStr(2, uc, «$») – 2)

a.Range(«A1:» & wc & uf).Copy

ts = «[Tabla1]»
objWord.Selection.Move 6, -1
objWord.Selection.Find.Execute FindText:=ts
While objWord.Selection.Find.Found = True
objWord.Selection.PasteExcelTable False, True, False
objWord.Selection.Move 6, -1
objWord.Selection.Find.Execute FindText:=ts
Wend

Dim tabla As Table
For Each tabla In objWord.ActiveDocument.Tables
tabla.Style = «Tabla con cuadrícula 2 – Énfasis 1»
tabla.AutoFitBehavior wdAutoFitWindow
With objWord.ActiveDocument.Styles(«Tabla con cuadrícula 2 – Énfasis 1»).Font
 .Size = 8
 .Color = wdColorAutomatic
End With
Next

wdDoc.SaveAs Filename:=rutainf, FileFormat:=wdFormatXMLDocument
wdDoc.Close
wdDoc.Quit

a.Delete
Sheets(«Hoja1»).Select
MsgBox «El reporte se exportó a Word 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://macrosenexcel.com  **** https://youtube.com/programarexcel*********

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