Foros del Web » Programación para mayores de 30 ;) » Programación General » Visual Basic clásico »

No me llena el MSFlexGrid (VB6 sp6)

Estas en el tema de No me llena el MSFlexGrid (VB6 sp6) en el foro de Visual Basic clásico en Foros del Web. Hola de nuevo, tengo un último problema para terminar un ejercicio de búsqueda de datos de VB6 (sp6) contra Access. Tengo otros formularios dentro del ...
  #1 (permalink)  
Antiguo 02/03/2010, 08:12
 
Fecha de Ingreso: marzo-2005
Mensajes: 118
Antigüedad: 19 años
Puntos: 1
No me llena el MSFlexGrid (VB6 sp6)

Hola de nuevo, tengo un último problema para terminar un ejercicio de búsqueda de datos de VB6 (sp6) contra Access. Tengo otros formularios dentro del mismo proyecto parecidos al de la imagen que muestro, y funcionan correctamente, y he buscado diferencias en dichos formularios con el que me falla y parece que lo tengo todo correcto (supongo que no). No sé por qué, pero no hace nada cuando pulso el botón "Iniciar la búsqueda", que pulsándolo al tener activo el botón de radio 'desde ..... hasta', debería
llenarse el MSFlexGrid 'ARenovarCESOL' con un montón de registros. No da ningún error, simplemente no
hace nada.

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 disculpándome por esta parrafada dejo, tanto el 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. Lo pongo en dos post seguidos para que quepa, éste y la 1ª respuesta.



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 SIGUIENTE RESPUESTA)-->

Última edición por juanfosaiz; 02/03/2010 a las 09:21 Razón: falta de datos
  #2 (permalink)  
Antiguo 02/03/2010, 09:14
 
Fecha de Ingreso: marzo-2005
Mensajes: 118
Antigüedad: 19 años
Puntos: 1
Respuesta: No me llena el MSFlexGrid (VB6 sp6)

' ************************************************** ********
' 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.

Última edición por juanfosaiz; 02/03/2010 a las 09:19 Razón: Ordenación de los datos
  #3 (permalink)  
Antiguo 03/03/2010, 09:37
 
Fecha de Ingreso: marzo-2005
Mensajes: 118
Antigüedad: 19 años
Puntos: 1
Respuesta: No me llena el MSFlexGrid (VB6 sp6)

Hola de nuevo. Bueno parece que ya he conseguido solucionar el 'problemilla' (uff), he picado de nuevo todo el código y ahora me sale, con el único errorcillo de que, una vez se llena el MSFlexGrid de registros, seleccionar uno y dar al botón 'Ver Expediente', me da un

Error '3061' en tiempo de ejecucción. Pocos parámetros. Se esperaba 1

He mirado en otros hilos del foro y me he informado que puede ser que me pida un dato que no ha sido recogido, pero he comprobado el código y parece estar bien, por eso quería preguntar si este error puede ser producido por otra causa.

Venga gracias de nuevo y perdonar por el peazo de mensaje que puse ayer, me pilló el toro con el código y me desmoroné un poco.

Saludos.

Última edición por juanfosaiz; 03/03/2010 a las 09:40 Razón: Errata

Etiquetas: vb
Atención: Estás leyendo un tema que no tiene actividad desde hace más de 6 MESES, te recomendamos abrir un Nuevo tema en lugar de responder al actual.
Respuesta




La zona horaria es GMT -6. Ahora son las 07:00.