Filtrar dos fechas en los textbox correspondientes para cada uno en un listbox.

Option Explicit
Dim tbl1 As ListObject, tbl2 As ListObject

Private Sub UserForm_Initialize()
'------------------
'by Cacho Rodríguez
'------------------
Dim Tmp

Set tbl1 = Range("Tabla8").ListObject
Set tbl2 = Range("tbl_Auxiliar1").ListObject

ListBox1.RowSource = tbl1.Name

Tmp = DateSerial(2018, 12, 31)
Tmp = Replace(Replace(Replace(Tmp, Year(Tmp), "yy"), 12, "mm"), 31, "dd")
Label1 = "Fecha inicial" & vbLf & "(" & Tmp & ")"
Label2 = "Fecha final" & vbLf & "(" & Tmp & ")"
End Sub

Private Sub TextBox1_Change()
Filtro
End Sub

Private Sub TextBox2_Change()
Filtro
End Sub

Private Sub Filtro()
Dim Tabla$, Sql$

If Not IsDate(TextBox1) Or Not IsDate(TextBox2) Then Exit Sub

Tabla = "[" & tbl1.Range.Worksheet.Name & "$" & tbl1.Range.Address(0, 0) & "]"
Sql = "SELECT * FROM " & Tabla & " WHERE [Fecha]>=#" & _
Format(CDate(TextBox1), "mm/dd/yy") & "# And [Fecha]<=#" & _
Format(CDate(TextBox2), "mm/dd/yy") & "#"
If tbl2.ListRows.Count > 0 Then tbl2.DataBodyRange.Delete xlUp

With CreateObject("adodb.Connection")
.Provider = "Microsoft.ACE.OLEDB.12.0"
.Properties("Data Source") = ThisWorkbook.FullName
.Properties("Extended Properties") = "Excel 12.0 Xml;HDR=YES"
.Open
tbl2.HeaderRowRange.Offset(1).CopyFromRecordset .Execute(Sql)
ListBox1.RowSource = tbl2.Name
.Close
End With

End Sub

El error del siguiente código es que sale el siguiente error 

Bueno este código me lo pasaron en un foro para mi proyecto pero no me funciona, el error es lo que mencione anteriormente...

1 Respuesta

Respuesta

¿En qué línea te da el error?

Abraham Valencia

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas