Run Code
|
API
|
Code Wall
|
Misc
|
Feedback
|
Login
|
Theme
|
Privacy
|
Patreon
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
exercicio A
VB.NET: Functions aren't required to return a value
Poem of the day from 'Selected Poems of Rumi (Dover Thrift Edition)'
CAI Visual Basic - Libreria Funciones
exercicio 3
String
Exercico 2
CAI Visual Basic - Ej Citas
wunder
No Fear Shakespeare sonnet of the day