CAI Visual Basic - Ej Citas, Visual Basic

CAI Visual Basic - Ej Citas

Private Sub Form_Load()

Dim oDB As Database
Set oDB = abrirDB("citas", oDB)

Dim persona As Recordset
Set persona = abrirTabla("Persona", oDB)

Dim strCriterioA, strCriterioB, strCriterioC, strCriterioD As String

'Criterio A
'Criterio que obtenga un listado con las personas activas del sexo buscado por
'el usuario actual, y que no tengan más de X años de diferencia de edad (donde
'X está representado por el valor de la variable intMaxDifEdad). Excluir al
'usuario propio (persona actual) del resultado
'Dimensiono los limites mayor e inferior
Dim intMaxDifEdad As Integer
intMaxDifEdad = 10
Dim intFechaMin, intFechaMax As String
intFechaMin = Format(DateAdd("yyyy", -intMaxDifEdad, persona("per_FechaNacimiento")), "dd/mm/yyyy")
intFechaMax = Format(DateAdd("yyyy", intMaxDifEdad, persona("per_FechaNacimiento")), "dd/mm/yyyy")

strCriterioA = "per_Codigo <> " & persona("per_Codigo") & _
" and per_Sexo = " & persona("per_SexoBuscado") & _
" and per_Activo = True and per_FechaNacimiento between #" & intFechaMax & "# and #" & intFechaMin & "#"

'Criterio B
'Dimensiono los meses de inactividad
Dim intMesesInactividad As Integer
intMesesInactividad = 4
Dim fechaInactividad As String
fechaInactividad = Format(DateAdd("m", -intMesesInactividad, Date), "dd/mm/yyyy")

strCriterioB = "per_Activo = True and #" & persona("per_UltimoIngreso") & "# <" & fechaInactividad & "#"

'Criterio C
Dim ingCodSexo As Integer
ingCodSexo = 1

strCriterioC = "per_Activo = True and per_Sexo = " & ingCodSexo & " and per_Provincia = " & persona("per_Provincia")

'Criterio D
Dim strNombre As String
strNombre = "uan"
Dim ingresoUltimoMes As String
ingresoUltimoMes = Format(DateAdd("m", -1, Date), "dd/mm/yyyy")

strCriterioD = "per_Nombre like '*" & strNombre & _
"*'and (per_Activo = True or per_UltimoIngreso > #" & ingresoUltimoMes & "#"

'Punto 2
Private Function amiEnComun(cod1 As Integer, cod2 As Integer) As Integer
    
    Dim rsPersonaActiva, rsAmistad1, rsAmistad2  As Recordset
    Set rsPersonaActiva = abrirTabla("Persona", oDB)
    Set rsAmistad1 = abrirTabla("Amistades", oDB)
    Set rsAmistad2 = abrirTabla("Amistades", oDB)
    
    Dim criterioAmistad1, criterioAmistad2, criterioPersonaActiva As String
    criterioAmistad1 = "ami_Activo = True and  ami_Origen =" & cod1
    criterioAmistad2 = "ami_Activo = True and  ami_Origen =" & cod2
    criterioPersonaActiva = "per_Activo = True and per_Codigo =" & rsAmistad1(ami_Destino)
    
    ' Dimensiono contador
    Dim contador As Integer
    contador = 0
    
    rsAmistad1.FindFirst criterioAmistad1
    Do While Not rsAmistad1.NoMatch
        rsAmistad2.FindFirst criterioAmistad2
        Do While Not rsAmistad2.NoMatch
            If rsAmistad1("ami_Destino") = rsAmistad2("ami_Destino") Then
                rsPersonaActiva.FindFirst criterioPersonaActiva
                    Do While Not criterioPersonaActiva.NoMatch
                        'Lleno un lst?
                        agregarItemLista lstAmistades, criterioPersonaActiva("per_Nombre"), criterioPersonaActiva("per_Codigo")
                        contador = contador + 1
                        rsPersonaActiva.FindNext criterioPersonaActiva
                    Loop
            End If
            rsAmistad2.FindNext criterioAmistad2
        Loop
        
        
        
        
        rsAmistad1.FindNext criterioAmistad1
    Loop
    
  amiEnComun = contador
  cerrarTabla rsAmistad2
  cerrarTabla rsAmistad1
  cerrarTabla rsPersonaActiva
  End Function
  
  
Ej 3
  Private Sub chequeaProvincia(ByRef combo As String, ByVal codprov As Integer)
    cboProvincia.Clear
    If codprov <> -1 Then
        Dim provincias As Recordset
        Set provincias = abrirTabla("Provincia", oDB)
        
        Dim criterioProvincias As String
        criterioProvincias = "pro_Activo = True"
        provincias.FindFirst criterioProvincias
        
        agregarComboPlaceholder cboProvincia, "Seleccione Provincia"
        Do While Not provincias.NoMatch
            agregarItemCombo cboProvincia, provincias("pro_Nombre"), provincias("pro_Codigo")
            provincias.FindNext criterioProvincias
        Loop
        
        cboProvincia.ListIndex = codprov
     cerrarTabla provincias
 
    Else
        cboProvincia.ListIndex = -1
    End If
    
  End Sub

cerrarTabla provincias

End Sub


run \| edit \| history \| help	0