Se cierra la App al imprimir con Crystal ¡Por Qué!
Publicado por Jorge (56 intervenciones) el 21/07/2010 20:01:02
Mando a imprimir en un reporte de crystal e imprime, pero la segunda vez que envio algo para imprimir se cierra el programa (pero solo cuando activo el codigo para imrimir con crystal, ya que la busqueda la hace rapida y las veces que quiera pero activo la impresion con crystal y el resultado se demora y solo funciona 1 vez)... Waaaaaa me estoy volviendo loco :(
La base de datos es una tabla de FOX Pro (mi_tabla.dbf) en la carpeta "C:\MI_BD" no la uso para escribir datos en ella sino solo para leer los datos de alli y realizar un reporte.
Aqui va el codigo:
'Variables para Crystal Reports (version 9)
Dim crApp As CRAXDRT.Application
Dim crReport As CRAXDRT.Report
Dim crParamDefs As CRAXDRT.ParameterFieldDefinitions
Dim crParamDef As CRAXDRT.ParameterFieldDefinition
'Variables para la conexion a la BD y el registro
Private cnn As ADODB.Connection
Private rst As ADODB.Recordset
'----------------------------------------------------
'Aqui abro la conexion para una BD .dbf de fox
'solo me interesa leer los datos de esa BD, no ingresar datos
Private Function IniCnn()
Set cnn = Nothing
Set cnn = New ADODB.Connection
cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=C:\MI_BD;" & _
"Extended Properties=dBASE IV;" & _
"User ID=Admin;Password=;"
cnn.CursorLocation = adUseClient
End Function
'----------------------------------------------------
'Este es el Boton "Buscar" para generar el reporte de la BD de FOX
Private Sub btBuscar_Click()
'Inicio la conexion
call IniCnn()
'Asigno variables de registro y de crystal
Set rst = Nothing
Set rst = New ADODB.Recordset
Set crApp = New CRAXDRT.Application
'si el registro esta abierto entonces lo cierro (digo por las dudas)
If rst.State = 1 Then rst.Close
'ejecuto la busqueda SQL (donde SQLBuscar es "select * from mi_tabla")
rst.Open SQLBuscar, cnn, adOpenDynamic, adLockOptimistic
If rst.RecordCount > 0 Then 'Si hay resultados entonces realizamos la busqueda
rst.MoveFirst
labelDatos(0).Caption = rst!NombreAlmacen
'... y asi muestra en pantalla algunos datos en algunos labels
If rst.EOF Then
rst.MoveLast
Else
rst.MoveNext
End If
'Hasta aqui todo perfecto, busco las veces que quiero y muestra el
'resultado rapido pero cuando envio a un reporte de crystal se
'demora como 4 segundos en terminar la busqueda.
'El reporte esta hecho con TTX de crystal
'y al querer volver a imprimir se sale la aplicacion osea se cierra.
'entonces solo acepta 1 busqueda, solo imprime una vez o.O!
'luego hay que volver a abrir el programa para hacer otra impresion
'*********************** CRYSTAL ***********************
On Error GoTo ErrHandler
rst.MoveFirst '(por las dudas me voy al primer resultado)
Set crReport = Nothing
Set crReport = crApp.OpenReport(App.Path & "\Rpt\dlgModeloDoc.rpt", 1)
'envio el recorset al reporte como fuente de origen de datos
crReport.Database.SetDataSource rst
Set crParamDefs = crReport.ParameterFields
For Each crParamDef In crParamDefs
Select Case crParamDef.ParameterFieldName
'Envio el parametro TotalEnLetras que pide el reporte y que es un String
Case "TotalEnLetras"
crParamDef.AddCurrentValue (TotalEnLetras(CInt(rst!total)))
End Select
Next
'Me muestra las impresoras disponibles
crReport.PrinterSetup (hWnd)
'envio a imprimir en la impresora seleccionada
crReport.PrintOut
'\*********************** CRYSTAL ***********************/'
End If
rst.Close
Set rst = Nothing
Set crParamDefs = Nothing
Set crParamDef = Nothing
Set crReport = Nothing
Set crApp = Nothing
Exit Sub
ErrHandler:
If Err.Number = -2147206461 Then
MsgBox "El archivo de reporte no se encuentra", vbCritical + vbOKOnly
Else
MsgBox Err.Description, vbCritical + vbOKOnly
End If
rst.Close
Set rst = Nothing
Set crParamDefs = Nothing
Set crParamDef = Nothing
Set crReport = Nothing
Set crApp = Nothing
End Sub
La base de datos es una tabla de FOX Pro (mi_tabla.dbf) en la carpeta "C:\MI_BD" no la uso para escribir datos en ella sino solo para leer los datos de alli y realizar un reporte.
Aqui va el codigo:
'Variables para Crystal Reports (version 9)
Dim crApp As CRAXDRT.Application
Dim crReport As CRAXDRT.Report
Dim crParamDefs As CRAXDRT.ParameterFieldDefinitions
Dim crParamDef As CRAXDRT.ParameterFieldDefinition
'Variables para la conexion a la BD y el registro
Private cnn As ADODB.Connection
Private rst As ADODB.Recordset
'----------------------------------------------------
'Aqui abro la conexion para una BD .dbf de fox
'solo me interesa leer los datos de esa BD, no ingresar datos
Private Function IniCnn()
Set cnn = Nothing
Set cnn = New ADODB.Connection
cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=C:\MI_BD;" & _
"Extended Properties=dBASE IV;" & _
"User ID=Admin;Password=;"
cnn.CursorLocation = adUseClient
End Function
'----------------------------------------------------
'Este es el Boton "Buscar" para generar el reporte de la BD de FOX
Private Sub btBuscar_Click()
'Inicio la conexion
call IniCnn()
'Asigno variables de registro y de crystal
Set rst = Nothing
Set rst = New ADODB.Recordset
Set crApp = New CRAXDRT.Application
'si el registro esta abierto entonces lo cierro (digo por las dudas)
If rst.State = 1 Then rst.Close
'ejecuto la busqueda SQL (donde SQLBuscar es "select * from mi_tabla")
rst.Open SQLBuscar, cnn, adOpenDynamic, adLockOptimistic
If rst.RecordCount > 0 Then 'Si hay resultados entonces realizamos la busqueda
rst.MoveFirst
labelDatos(0).Caption = rst!NombreAlmacen
'... y asi muestra en pantalla algunos datos en algunos labels
If rst.EOF Then
rst.MoveLast
Else
rst.MoveNext
End If
'Hasta aqui todo perfecto, busco las veces que quiero y muestra el
'resultado rapido pero cuando envio a un reporte de crystal se
'demora como 4 segundos en terminar la busqueda.
'El reporte esta hecho con TTX de crystal
'y al querer volver a imprimir se sale la aplicacion osea se cierra.
'entonces solo acepta 1 busqueda, solo imprime una vez o.O!
'luego hay que volver a abrir el programa para hacer otra impresion
'*********************** CRYSTAL ***********************
On Error GoTo ErrHandler
rst.MoveFirst '(por las dudas me voy al primer resultado)
Set crReport = Nothing
Set crReport = crApp.OpenReport(App.Path & "\Rpt\dlgModeloDoc.rpt", 1)
'envio el recorset al reporte como fuente de origen de datos
crReport.Database.SetDataSource rst
Set crParamDefs = crReport.ParameterFields
For Each crParamDef In crParamDefs
Select Case crParamDef.ParameterFieldName
'Envio el parametro TotalEnLetras que pide el reporte y que es un String
Case "TotalEnLetras"
crParamDef.AddCurrentValue (TotalEnLetras(CInt(rst!total)))
End Select
Next
'Me muestra las impresoras disponibles
crReport.PrinterSetup (hWnd)
'envio a imprimir en la impresora seleccionada
crReport.PrintOut
'\*********************** CRYSTAL ***********************/'
End If
rst.Close
Set rst = Nothing
Set crParamDefs = Nothing
Set crParamDef = Nothing
Set crReport = Nothing
Set crApp = Nothing
Exit Sub
ErrHandler:
If Err.Number = -2147206461 Then
MsgBox "El archivo de reporte no se encuentra", vbCritical + vbOKOnly
Else
MsgBox Err.Description, vbCritical + vbOKOnly
End If
rst.Close
Set rst = Nothing
Set crParamDefs = Nothing
Set crParamDef = Nothing
Set crReport = Nothing
Set crApp = Nothing
End Sub
Valora esta pregunta


0