Pueden revisar este codigo por favor...
Dim cn As ADODB.Connection
Dim tb As New ADODB.Recordset
Dim sql1, sql2, sql3, sql4, sql5, sql6 As String
Private Sub cmdCerrar_Click()
Unload Me
End Sub
Private Sub cmdExportar_Click()
If chkIngresos.Value = 1 And chkSalidas.Value = 0 Then
sql1 = "select * from orden_entrega where gs_fecha = datevalue('" & CStr(DTPicker.Value) & "')"
sql2 = "select detalle_oe.*, gs_fecha from detalle_oe iner join orden_entrega on orden_entrega.nro_gs = detalle_oe.nro_gs where gs_fecha = datevalue('" & CStr(DTPicker.Value) & "')"
sql3 = "select * from kardex where fecha = datevalue('" & CStr(DTPicker.Value) & "')"
ExportarExcel (sql1)
ExportarExcel (sql2)
ExportarExcel (sql3)
ElseIf chkIngresos.Value = 0 And chkSalidas.Value = 1 Then
End
Else
End
End If
End Sub
Private Sub Form_Load()
' conexion a la Base de Datos
Set cn = New ADODB.Connection
cn.ConnectionString = "Data Source= Set Cn = New ADODB.Connection"
cn.Provider = "Microsoft.Jet.Oledb.4.0"
cn.ConnectionString = App.Path & ("ST.mdb")
cn.Open
' fin de la conexion
Me.Height = 4035
Me.Width = 4455
End Sub
Public Sub ExportarExcel(ByVal sql As String, Optional titulo_Tabla As String = "")
Set tb = New ADODB.Recordset
Dim libro As New Excel.Application
tb.Open sql, cn, adOpenKeyset
With libro
libro.Visible = True
libro.Workbooks.Add
Dim b As Integer, Fil As Integer
For b = 0 To tb.Fields.Count - 1
.Cells(1, b + 1).Value = tb.Fields(b).Name
Next
Fil = 0
'Exportación de la data
tb.MoveFirst
Do While Not tb.EOF
For b = 0 To tb.Fields.Count - 1
.Cells(2 + Fil, b + 1).Value = tb.Fields(b)
Next
Fil = Fil + 1
tb.MoveNext
Loop
End With
End Sub
me sale error cuando entra para dar valor a sql1 ... no se como hacerlo... alguien me puede decir como paso la consulta como parametro???
Saludos y muchas gracias....
Dim tb As New ADODB.Recordset
Dim sql1, sql2, sql3, sql4, sql5, sql6 As String
Private Sub cmdCerrar_Click()
Unload Me
End Sub
Private Sub cmdExportar_Click()
If chkIngresos.Value = 1 And chkSalidas.Value = 0 Then
sql1 = "select * from orden_entrega where gs_fecha = datevalue('" & CStr(DTPicker.Value) & "')"
sql2 = "select detalle_oe.*, gs_fecha from detalle_oe iner join orden_entrega on orden_entrega.nro_gs = detalle_oe.nro_gs where gs_fecha = datevalue('" & CStr(DTPicker.Value) & "')"
sql3 = "select * from kardex where fecha = datevalue('" & CStr(DTPicker.Value) & "')"
ExportarExcel (sql1)
ExportarExcel (sql2)
ExportarExcel (sql3)
ElseIf chkIngresos.Value = 0 And chkSalidas.Value = 1 Then
End
Else
End
End If
End Sub
Private Sub Form_Load()
' conexion a la Base de Datos
Set cn = New ADODB.Connection
cn.ConnectionString = "Data Source= Set Cn = New ADODB.Connection"
cn.Provider = "Microsoft.Jet.Oledb.4.0"
cn.ConnectionString = App.Path & ("ST.mdb")
cn.Open
' fin de la conexion
Me.Height = 4035
Me.Width = 4455
End Sub
Public Sub ExportarExcel(ByVal sql As String, Optional titulo_Tabla As String = "")
Set tb = New ADODB.Recordset
Dim libro As New Excel.Application
tb.Open sql, cn, adOpenKeyset
With libro
libro.Visible = True
libro.Workbooks.Add
Dim b As Integer, Fil As Integer
For b = 0 To tb.Fields.Count - 1
.Cells(1, b + 1).Value = tb.Fields(b).Name
Next
Fil = 0
'Exportación de la data
tb.MoveFirst
Do While Not tb.EOF
For b = 0 To tb.Fields.Count - 1
.Cells(2 + Fil, b + 1).Value = tb.Fields(b)
Next
Fil = Fil + 1
tb.MoveNext
Loop
End With
End Sub
me sale error cuando entra para dar valor a sql1 ... no se como hacerlo... alguien me puede decir como paso la consulta como parametro???
Saludos y muchas gracias....
Qué error te da? es que viéndolo asà por encima no me parece ver nada extraño.
No te preocupes ya lo resolvi era una tonteria... donde dice dtpicker es dtpicker1, no me di cuenta y habia borado de casualidad.... pero bueno tengo otra consulta este codigo me permita exportar a excel cada tabla en un archivo distinto, me gustaria exportar cada tabla en una hoja distinta, sabes de casualidad como puedo hacerlo????
Muchas gracias
Saludos
Catty
Muchas gracias
Saludos
Catty
