lacasa.gif (1778 bytes)el virus.gif (1811 bytes)

La Casa                      El Virus

Queries y Formularios:

    Aqui les traigo un pequeño programa el cual a mi parecer le puede servir bastante, en mi trabajo hay mucha gente que no sabe hacer nada de nada (con respecto a programas).  Les cuento... Cree una aplicación con Access la cual mantiene información de nuestros clientes, cuando empeze a crear la aplicación tuve que tener reuniones con los usuarios para definir los requerimientos (hasta aqui nada fuera de lo común).  Los requerimientos, despues de muchas charlas, fueron definidos y empeze a trabajar en la BD.  La BD les proveeria: Formularios para entrar y ver información, reportes de todo tipos y otras cosas más. Uno de los últimos requerimientos era que yo deberia proveer información o reportes fuera de lo ordinario, pues como anteriormente los usuarios no eran muy conocidos de computadoras, y como yo no queria que me estuviesen llamando a todas horas pidiendome que les cree un nuevo query, el cual les brindaria la info que desen empeze a crear una pequeña aplicación la cual actuaria basicamente como un  Mago o Wizard!! Aqui va el codigo y gráficos para tu uso (Una cosa que me olvidava mis usuarios son gringos asi que las variables usadas en el programa son en ingles, pero se que esto no sera ningun problema para ti pues lo importante es el codigo).

El formulario

formulario.gif (7060 bytes)

Ahora que ya sabes como es el resultado final comensemos a crear el corazón de este:

Primero definimos las declaraciones explicitas, 
Option Compare Database 'Usamos el orden de la base de datos para comparar strings
Option Explicit

Dim astrTables() As String * 50
'Aqui empezamos a declarar nuestro codigo SQL
Const STR_DISTINCT = "SELECT DISTINCTROW"
Const STR_SELECT = "SELECT"
Const STR_FROM = "FROM"
Const STR_WHERE = "WHERE"
Const STR_ORDERBY = "ORDER BY"
Const STR_OWNERSACCESS = "WITH OWNERACCESS OPTION;" 
Const STR_NOOWNERSACCESS = ";"
Const LBL_BLUE = 8388608
Const LBL_GREY = 8421504
Const LBL_YELLOW = 65535
Const MB_OK = 0, MB_OKCANCEL = 1 ' Definimos los botones
Const MB_YESNO = 4
Const MB_ICONQUESTION = 32, IDYES = 6 ' Definimos los  icons.
Const ERR_PROPERTY_NONEXISTENT = 3270
Const ERR_OBJECT_NONEXISTENT = 3265

Const KEY_CANCEL = &H3
Const KEY_BACK = &H8
Const KEY_TAB = &H9
Const KEY_RETURN = &HD
Const KEY_SHIFT = &H10
Const KEY_PRIOR = &H21
Const KEY_NEXT = &H22
Const KEY_HOME = &H24
Const KEY_LEFT = &H25
Const KEY_UP = &H26
Const KEY_RIGHT = &H27
Const KEY_DOWN = &H28

Dim strSQL As String 'seguimos declarando  as definiciones de SQL
Dim strSQLSelect As String
Dim strSQLFrom As String
Dim strSQLWhere As String
Dim strSQLWhereField As String
Dim strSQLOrderBy As String

Dim strFieldSelect As String * 255
Dim strFieldOrderBy As String * 255
Dim strLastWhere As String * 255
Dim strLastCrit As String * 255
Dim strTableFrom As String * 255

Dim cintTables As Integer 'Número de Tablas en FROM
Dim cintFields As Integer 'Número de campos en SELECT
Dim cintOrderFields As Integer 'Número de campos ein ORDER BY
Dim cintWhere As Integer 'Número de reglas en WHERE
Dim intReturn As Integer 'General-purpose return value
Dim fintToolTip As Integer 'Bandera para los tips (tooltips)

Dim ctrlDistinctRow As Control 'chkDistinctRow checkbox
Dim ctrlOwnersAcc As Control 'chkOwnersAccess checkbox

Dim ctrlFields As Control
Dim ctrlSortFields As Control
Dim ctrlWhereFields As Control
Dim ctrlTableList As Control
Dim ctrlAggregate As Control
Dim ctrlgrpAndOr As Control

Dim ctrlLblAnd As Control
Dim ctrlLblOr As Control
Dim ctrlLblFld As Control
Dim ctrlLblSortFld As Control
Dim ctrlLblWhereFld As Control
Dim ctrlLblWhere As Control
Dim ctrlLblWhereCrit As Control
Dim ctrlLblAggregate As Control
Dim ctrlLblToolTip As Control

Dim ctrlLblTT As Control

Dim ctrlTxtSql As Control
Dim ctrlTxtWhereFld As Control
Dim ctrlTxtWhereCrit As Control

Dim ctrlCmdAddWhere As Control
Dim ctrlCmdCreateQuery As Control
Dim ctrlCmdDeleteQuery As Control

Dim frmName As String * 255
Luego cuando el formulario se abre...
Private Sub Form_Open(Cancel As Integer)
On Error Resume Next

Dim dbCurrent As Database
Dim iaintTable As Integer, intTblCnt As Integer
Dim iaintCounter As Integer, intReturn As Integer

Set dbCurrent = CurrentDb()

iaintCounter = 0
intTblCnt = dbCurrent.TableDefs.Count - 1

ReDim astrTables(intTblCnt)

For iaintTable = 0 To intTblCnt
If Left(dbCurrent.TableDefs(iaintTable).name, 4) <> "MSys" Then    'No las tablas de sistema
    If Left(dbCurrent.TableDefs(iaintTable).name, 2) <> "LB" Then
        astrTables(iaintCounter) = dbCurrent.TableDefs(iaintTable).name
        iaintCounter = iaintCounter + 1
    End If
End If
Next

ReDim Preserve astrTables(iaintCounter)

''' Inicializamos las variables de SQL y los controles de los formularios
mtwInitilizeCtls  'llamamos funcion mtwinitilizectls
mtwInitilizeSQL 'llamamos funcion mtwinitilizesql


''' Toggle botones y  labels (no se como se dice en lengua hispana :)
mtwToggleBtnMain cintTables

''' Toggle controles agregados
mtwToggleWhereAggregate False

''' Toggle controles de criterio
mtwToggleWhereCriteria False

''' Toggle cmdAddWhere boton
mtwToggleCmDWhere False

''' Toggle los AND/OR grupo de botones
mtwToggleAndOr cintWhere
End Sub
Te habras dado cuenta que cuando este formulario se habre no solo ejecuta el codigo en open form pero tambien el siguiente:
Private Sub mtwInitilizeCtls()
On Error Resume Next

''' Comentarios: Esta rutina inicia controles comunes de referencia
''' en este modulo
'''
''' Llamada por : Form_Open
'''
''' Argumentos: Ninguno
'''
''' Devuelve: Nada
'''
''' Palabras clave: Inicia  Controles
'''
''' Date        Developer    Accion
''' -------------------------------------------------------------
''' 03/01/98 Skar man      Creada
'''
frmName = Me.name

Set ctrlDistinctRow = Me!chkDistinctRow
Set ctrlOwnersAcc = Me!chkOwnersAccess
Set ctrlWhereFields = Me!cboWhereFields
Set ctrlFields = Me!cboFields
Set ctrlSortFields = Me!cboSortFields
Set ctrlTableList = Me!cboTblList
Set ctrlAggregate = Me!cboAggregate

Set ctrlLblWhereFld = Me!lblWhereFields
Set ctrlLblFld = Me!lblFields
Set ctrlLblSortFld = Me!lblSortFields
Set ctrlLblWhere = Me!lblWhere
Set ctrlLblWhereCrit = Me!lblWhereCriteria
Set ctrlLblAggregate = Me!lblAggregate
Set ctrlLblAnd = Me!lblAnd
Set ctrlLblOr = Me!lblOR
Set ctrlLblTT = Me!lblToolTip

Set ctrlTxtSql = Me!txtSQL
Set ctrlTxtWhereFld = Me!txtWhereField
Set ctrlTxtWhereCrit = Me!txtWhereCriteria

Set ctrlCmdAddWhere = Me!cmdAddWhere
Set ctrlCmdCreateQuery = Me!cmdCreateQuery
Set ctrlCmdDeleteQuery = Me!cmdDeleteQuery

Set ctrlgrpAndOr = Me!grpAndOr
Set ctrlLblToolTip = Me!zslblToolTip
End Sub
Private Sub mtwInitilizeSQL()
On Error Resume Next

''' Comments: Esta rutina asigna valores e iniciaThis routine Assigns default values and initilizes
''' variables al nivel de modulo.
'''
''' Called by: Form_Open
'''
''' Arguments: None
'''
''' Returns: None
'''
''' Keywords: Inicia Variables
'''
''' Date       Developer Action
''' -------------------------------------------------------------
''' 03/01/98 Skarman  Created
'''

strSQL = ""
strSQLSelect = ""
strSQLFrom = ""
strSQLWhere = ""
strSQLOrderBy = ""
strSQLWhereField = ""
strFieldSelect = ""
strFieldOrderBy = ""
strLastWhere = ""
strTableFrom = ""
cintTables = 0
cintFields = 0
cintWhere = 0
cintOrderFields = 0
intReturn = 0
ctrlTxtSql = ""
fintToolTip = True
End Sub
Saben una cosa en vez de escribir todo el codigo aca mejor bajenlo querywizard ojo que todo esta en ingles . Si tienen preguntas o dudas como funciona escribanme o visiten las cuevas.

 

La Cueva, parte de la red de Cuevas, Inc., Para info en general escriban a   Skar