Visual Basic - No me llena el MSFlexGrid (VB6 sp6)

Life is soft - evento anual de software empresarial
   
Vista:

No me llena el MSFlexGrid (VB6 sp6)

Publicado por Juan Francisco (14 intervenciones) el 02/03/2010 16:26:04
Hola de nuevo, tengo un último problema para terminar un ejercicio de búsqueda de datos de VB6 (sp6) contra Access.
En el gráfico que expongo he puesto unas flechas indicando lo que creo que falla, una es la que hace referencia al objeto Data ('Data2'), y la otra es el MSFlexGrid ('ARenovarCESOL'). Al dar al Botón "Iniciar la búsqueda", deberían salir todos los resultados recogidos en 'Data2' dentro de 'ARenovarCESOL'. También he mirado en las propiedades de 'Data2' y mira a las tablas de la BBDD correspondiente. Con los mismos objetos de debajo de éstos pasa lo mismo.
Bueno, pues decididamente dejo, tanto la url del gráfico de la vista de diseño del formulario, como el código del procedimiento que se ejecuta al hacer click en el botón de 'Iniciar la búsqueda'; es algo largo, pero quizás le pueda servir alguien de copy/paste para algún ejercicio, básicamente tiene que estar casi correcto.

La imagen es ésta:

http://www.cesol.es/seguimiento.jpg

Y ahora el código (lo pongo en dos partes, en ete mensaje y en la primera respuesta, para que quepa entero):

------------------------------------------------------------
Option Explicit

Const ColNumCertif = 0
Const ColNombre = 1
Const ColFecha = 2
Const ColNumRenov = 3
Const ColCartaEnviada = 4

Dim NumColumnas As Integer

Private Sub Buscar_Click()
Dim Rec_Certificado As Recordset, Rec_RenovadoEmp As Recordset, Rec_RenovadoCESOL As Recordset
Dim Rec_DatPers As Recordset, Rec_SoldEmpresa As Recordset, Rec_SoldadorRenovado As Recordset
Dim InstSQL As String, linea As String, Num_Certificado As String
Dim FechaDesde As Date, FechaHasta As Date, FechaCad As Date, fecha As Date ', FDesde As Date,

FHasta As Date
Dim I As Integer
Dim FYaCaducados As Date

'codigo para buscar las renovaciones o caducados

If Option1(0).Value Then
' Caducados en los tres próximos meses.
FechaDesde = Date
FechaHasta = DateAdd("m", 3, Date)
ElseIf Option1(1).Value Then
' Caducados dentro del periodo indicado.
If Not IsDate(FDesde) Then
Beep
MsgBox "El formato de la fecha de inicio no es válido, asegúrese de introducirlo

correctamente", vbCritical, Tit_Gen
FDesde.SetFocus
Exit Sub
End If
If Not IsDate(FHasta) Then
Beep
MsgBox "El formato de la fecha de fin del período no es válido, introdúzcalo

correctamente", vbCritical, Tit_Gen
FHasta.SetFocus
Exit Sub
End If
FechaDesde = CDate(FDesde)
FechaHasta = CDate(FHasta)
Else
' Ya caducados antes de la fecha indicada.
If Not IsDate(FYaCaducados) Then
Beep
MsgBox "El formato de la fecha de ya caducados no es correcto.", vbCritical, Tit_Gen
'FYaCaducados.SetFocus
Exit Sub
End If
FechaHasta = CDate(FYaCaducados)

Screen.MousePointer = 11


InstSQL = "SELECT CERTIFICADO.* FROM CERTIFICADO"
InstSQL = InstSQL & "WHERE ((TIPO = " & TipoEN & ") AND ANULADO) "
InstSQL = InstSQL & "ORDER BY [FECHA-CERTIFICADO]; "
Set Rec_Certificado = BD_SOLDADORES.OpenRecordset(InstSQL, dbOpenDynaset)
If Rec_Certificado.RecordCount >= 1 Then
Load SOLDCaducados

Rec_Certificado.MoveFirst
Do While Not Rec_Certificado.EOF
If (Rec_Certificado("FECHA-ANULACION") <= FechaHasta) Then
' Añadir a la lista de los que caducan.

' Obtenemos primero los datos personales.
InstSQL = "SELECT DISTINCTROW CERTIFICADO.*, [DATOS-PERS].* "
InstSQL = InstSQL & "FROM [DATOS-PERS] INNER JOIN CERTIFICADO "
InstSQL = InstSQL & "ON [DATOS-PERS].[SOLDADOR-ID] = CERTIFICADO.[SOLDADOR-ID] "
InstSQL = InstSQL & "WHERE (((CERTIFICADO.[NUM-CERTIFICADO]) = '" &

Rec_Certificado("NUM-CERTIFICADO") & "'));"
Set Rec_DatPers = BD_SOLDADORES.OpenRecordset(InstSQL, dbOpenDynaset)
If Rec_DatPers.RecordCount >= 1 Then
linea = Rec_DatPers("NUM-CERTIFICADO") & Chr(9) _
& Rec_DatPers("APELLIDO1") & " " & Rec_DatPers("APELLIDO2") & ", " &

Rec_DatPers("NOMBRE")

' Obtenemos los datos de la empresa certificadora, si la tiene.
InstSQL = "SELECT DISTINCTROW CERTIFICADO.*, [DATOS-EMPRESA].* "
InstSQL = InstSQL & "FROM CERTIFICADO INNER JOIN [DATOS-EMPRESA] "
InstSQL = InstSQL & "ON CERTIFICADO.[EMPRESA-CERTIF-ID] =

[DATOS-EMPRESA].[EMPRESA-ID] "
InstSQL = InstSQL & "WHERE (((CERTIFICADO.[NUM-CERTIFICADO]) = '" &

Rec_Certificado("NUM-CERTIFICADO") & "'));"
Set Rec_SoldEmpresa = BD_SOLDADORES.OpenRecordset(InstSQL, dbOpenDynaset)
If Rec_SoldEmpresa.RecordCount >= 1 Then
' Mostrar nombre de la empresa.
linea = linea & Chr(9) & Leer(Rec_SoldEmpresa("NOMBRE"))
Rec_SoldEmpresa.Close
Else
Rec_SoldEmpresa.Close
' No hay empresa certificadora. Buscamos si existe de trabajo.
InstSQL = "SELECT DISTINCTROW CERTIFICADO.*, [DATOS-EMPRESA].* "
InstSQL = InstSQL & "FROM CERTIFICADO INNER JOIN [DATOS-EMPRESA] "
InstSQL = InstSQL & "ON CERTIFICADO.[EMPRESA-TRABAJO-ID] =

[DATOS-EMPRESA].[EMPRESA-ID] "
InstSQL = InstSQL & "WHERE (((CERTIFICADO.[NUM-CERTIFICADO]) = '" &

Rec_Certificado("NUM-CERTIFICADO") & "'));"
Set Rec_SoldEmpresa = BD_SOLDADORES.OpenRecordset(InstSQL, dbOpenDynaset)
If Rec_SoldEmpresa.RecordCount >= 1 Then
' Mostrar nombre de la empresa.
linea = linea & Chr(9) & Leer(Rec_SoldEmpresa("NOMBRE"))
Else
linea = linea & Chr(9) & " "
End If
Rec_SoldEmpresa.Close
End If

' Añadimos las fechas del certificado y de anulación
linea = linea & Chr(9) & Rec_Certificado("FECHA-CERTIFICADO")
linea = linea & Chr(9) & Rec_Certificado("FECHA-ANULACION")
SOLDCaducados.RejillaResultado.AddItem linea,

SOLDCaducados.RejillaResultado.Rows - 1
End If
End If
Rec_Certificado.MoveNext
Loop
If SOLDCaducados.RejillaResultado.Rows > 1 Then
SOLDCaducados.RejillaResultado.Rows = SOLDCaducados.RejillaResultado.Rows - 1
End If
Screen.MousePointer = 0
SOLDCaducados.Label1 = "Certificados de soldador ya caducados " & FYaCaducados
SOLDCaducados.Show 1
Else
Screen.MousePointer = 0
Beep
MsgBox "No existe ningún certificado con las condiciones seleccionadas", vbInformation,

Tit_Gen
End If
' End if
(SIGUE EN LA PRIMERA RESPUESTA) -->
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder

RE:No me llena el MSFlexGrid (VB6 sp6)

Publicado por Juan Francisco (14 intervenciones) el 02/03/2010 16:29:04
' **********************************************************
' BÚSQUEDA DE RENOVACIONES
' **********************************************************

If Not Option1(1).Value Then
' Sólo renovaciones, no caducados.

Screen.MousePointer = 11
' Limpiamos primero las dos rejillas de resultados.
If ARenovarEmpresa.Rows > 1 Then
For I = ARenovarEmpresa.Rows - 1 To 1 Step -1
ARenovarEmpresa.RemoveItem I
Next I
End If
ARenovarEmpresa.AddItem " " & Chr(9) & " " & Chr(9) & " " & Chr(9) & " " & Chr(9) & " ", ARenovarEmpresa.Rows - 1
ARenovarEmpresa.Rows = 1
If ARenovarCESOL.Rows > 1 Then
For I = ARenovarCESOL.Rows - 1 To 1 Step -1
ARenovarCESOL.RemoveItem I
Next I
End If
ARenovarCESOL.AddItem " " & Chr(9) & " " & Chr(9) & " " & Chr(9) & " " & Chr(9) & " ", ARenovarCESOL.Rows - 1
ARenovarCESOL.Rows = 1
InstSQL = "SELECT CERTIFICADO.* FROM CERTIFICADO WHERE ((TIPO = " & TipoEN & ") "
InstSQL = InstSQL & "AND NOT ANULADO AND NOT CADUCADO) "
'Añadido a esta linea AND NOT CADUCADO para que no muestre mas que los que se deben renovar
InstSQL = InstSQL & "ORDER BY [FECHA-CERTIFICADO]; "
Set Rec_Certificado = BD_SOLDADORES.OpenRecordset(InstSQL, dbOpenDynaset)
If Rec_Certificado.RecordCount >= 1 Then
Rec_Certificado.MoveFirst
Do While Not Rec_Certificado.EOF

Num_Certificado = Rec_Certificado("NUM-CERTIFICADO")
fecha = Rec_Certificado("FECHA-CERTIFICADO")
InstSQL = "SELECT [RENUEVA-CESOL].* FROM [RENUEVA-CESOL] "
InstSQL = InstSQL & "WHERE [NUM-CERTIFICADO] = '" & Num_Certificado & "' "
InstSQL = InstSQL & "ORDER BY FECHA;"
Set Rec_SoldadorRenovado = BD_SOLDADORES.OpenRecordset(InstSQL, dbOpenDynaset)
If Rec_SoldadorRenovado.RecordCount >= 1 Then
Rec_SoldadorRenovado.MoveLast
If Rec_SoldadorRenovado("RENOVACION-EFECTUADA") Then
fecha = Rec_SoldadorRenovado("FECHA-RENOVACION")
End If
End If
Rec_SoldadorRenovado.Close

For I = 1 To 12
' El certificado debe renovarse cada 6 meses por
'la empresa y cada 2 años por CESOL.


FechaCad = DateAdd("m", 6 * I, Rec_Certificado("fecha-certificado"))
If (FechaDesde <= FechaCad) And (FechaCad <= FechaHasta) Then
' Añadir a la lista de los que caducan

' Obtenemos primero los datos personales.
InstSQL = "SELECT DISTINCTROW CERTIFICADO.*, [DATOS-PERS].* "
InstSQL = InstSQL & "FROM [DATOS-PERS] INNER JOIN CERTIFICADO "
InstSQL = InstSQL & "ON [DATOS-PERS].[SOLDADOR-ID] = CERTIFICADO.[SOLDADOR-ID]

"
InstSQL = InstSQL & "WHERE (((CERTIFICADO.[NUM-CERTIFICADO]) = '" &

Rec_Certificado("NUM-CERTIFICADO") & "'));"
Set Rec_DatPers = BD_SOLDADORES.OpenRecordset(InstSQL, dbOpenDynaset)
If Rec_DatPers.RecordCount >= 1 Then
linea = Rec_DatPers("NUM-CERTIFICADO") & Chr(9) _
& Rec_DatPers("APELLIDO1") & " " & Rec_DatPers("APELLIDO2") & ", " & Rec_DatPers("NOMBRE") & Chr(9) _
& FechaCad & Chr(9) & " " & I & "ª"
InstSQL = "SELECT DISTINCTROW [RENUEVA-EMPRESA].* "
InstSQL = InstSQL & "FROM [RENUEVA-EMPRESA] "
InstSQL = InstSQL & "WHERE (([NUM-CERTIFICADO] = '" &
Rec_Certificado("NUM-CERTIFICADO") & "') "
InstSQL = InstSQL & "AND [ENVIADA-CARTA]);"
Set Rec_RenovadoEmp = BD_SOLDADORES.OpenRecordset(InstSQL, dbOpenDynaset)
If Rec_RenovadoEmp.RecordCount >= 1 Then
Rec_RenovadoEmp.MoveFirst
Do While Not Rec_RenovadoEmp.EOF
If CDate(Rec_RenovadoEmp("FECHA")) = CDate(FechaCad) Then
linea = linea & Chr(9) & "*"
Exit Do
End If
Rec_RenovadoEmp.MoveNext
Loop
If Rec_RenovadoEmp.EOF Then
linea = linea & Chr(9) & " "
End If
Else
linea = linea & Chr(9) & " "
End If
Rec_RenovadoEmp.Close
If I Mod 4 <> 0 Then
' Es una renovación de empresa
ARenovarEmpresa.AddItem linea, ARenovarEmpresa.Rows - 1
End If
If I Mod 4 = 0 Then
' Renovación por CESOL
' Comprobar estado de la renovación por CESOL
InstSQL = "SELECT DISTINCTROW [RENUEVA-CESOL].* "
InstSQL = InstSQL & "FROM [RENUEVA-CESOL] "
InstSQL = InstSQL & "WHERE ([NUM-CERTIFICADO] = '" &
Rec_Certificado("NUM-CERTIFICADO") & "'); "
Set Rec_RenovadoCESOL = BD_SOLDADORES.OpenRecordset(InstSQL, dbOpenDynaset)
If Rec_RenovadoCESOL.RecordCount = 0 Then
' No se le ha renovado ni se le ha enviado carta nunca.
' Puede añadirse a la lista de renovables.
linea = Rec_DatPers("NUM-CERTIFICADO") & Chr(9) _
& Rec_DatPers("APELLIDO1") & " " & Rec_DatPers("APELLIDO2")

& ", " & Rec_DatPers("NOMBRE") & Chr(9) _
& FechaCad & Chr(9) & " " & I / 4 & "ª"
ARenovarCESOL.AddItem linea, ARenovarCESOL.Rows - 1
Else
Rec_RenovadoCESOL.MoveFirst
Do While Not Rec_RenovadoCESOL.EOF
If (CDate(Rec_RenovadoCESOL("FECHA")) = CDate(FechaCad)) And _
Not Rec_RenovadoCESOL("RECIBIDA-DOCUMENTACION") Then
' Existe retistro de renovación del certificado, pero
'todavía no se ha recibido la documentación necesaria.
linea = Rec_Certificado("NUM-CERTIFICADO") & Chr(9) _
& Rec_DatPers("APELLIDO1") & " " &
Rec_DatPers("APELLIDO2") & ", " & Rec_DatPers("NOMBRE") & Chr(9) _
& FechaCad & Chr(9) & " " & I / 4 & "ª" & Chr(9) & "
" & "*"
ARenovarCESOL.AddItem linea, ARenovarCESOL.Rows - 1
Else 'segunda renovación
linea = Rec_DatPers("NUM-CERTIFICADO") & Chr(9) _
& Rec_DatPers("APELLIDO1") & " " & Rec_DatPers("APELLIDO2")

& ", " & Rec_DatPers("NOMBRE") & Chr(9) _
& FechaCad & Chr(9) & " " & I / 4 & "ª"
ARenovarCESOL.AddItem linea, ARenovarCESOL.Rows - 1
End If
Rec_RenovadoCESOL.MoveNext
Loop
End If
Rec_RenovadoCESOL.Close
End If
End If
Rec_DatPers.Close
End If
Next
Rec_Certificado.MoveNext
Loop
Screen.MousePointer = 0

If ARenovarEmpresa.Rows = 1 Then
Beep
MsgBox "No existe ningún certificado que renovar en el periodo seleccionado",

vbInformation, Tit_Gen
Else
ARenovarEmpresa.Rows = ARenovarEmpresa.Rows - 1
End If
If ARenovarCESOL.Rows > 1 Then
ARenovarCESOL.Rows = ARenovarCESOL.Rows - 1
End If
Else
Beep
MsgBox "No existe ningún certificado en la base de datos", vbInformation, Tit_Gen
End If
End If
End If
End Sub
-----------------------------------------------------------------

Gracias y perdón por la parrafada, quizás me he pasado pidiendo ayuda con este post.
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar