Un Gran Proyecto, Paso a Paso
Sexta Entrega (10/Abr/97)
Entregas anteriores: Primera,
Segunda, Tercera, Cuarta, Quinta
Lo dicho en otras ocasiones, es recomendable que les eches una visual para seguir el
hilo del proyecto.
Bajate las p�ginas HTML y los gr�ficos de
las 6 entregas. (gsnotas_htm.zip 76.0 KB)
Bajate los
listados del proyecto. (gsnotas.zip 30.4 KB)
(Estos tama�os variar�n seg�n el n�mero de entregas; para saber el tama�o actual,
deber�as ver la �ltima entrega)
Vamos a empezar hoy por el arreglo de algunas cosillas y a
definir un tipo de datos, que posteriormente usaremos en la consulta.
Lo que he cambiado, a�adido, est� en esta lista:
1.- Arreglar el "bug" de que se quede marcado como terminado cuando acabamos de a�adir un registro.
Para esto s�lo tienes que a�adir lo siguiente en la parte de Actualizaci�n, esta es parte del c�digo:
'... .Enabled = True 'A ver si as� se actualiza correctamente If Val(.Recordset.Terminada) Then Check1.Value = 1 Else Check1.Value = 0 End If .Refresh
2.- Asignar los valores por omisi�n al pulsar en Nuevo.
En esta ocasi�n, a�ade este c�digo al procedimiento cmdActualizar, en la parte de a�adir un Nuevo registro:
'... Data1.Enabled = False 'Asignar la fecha actual Text1(cFecha) = Format$(Now, "Short Date") Text1(cFechaInicio) = Text1(cFecha) Text1(cTerminada) = "0" YaEstoyAqui = False '...
3.- Una variable definida (TYPE) para saber con que campos estamos trabajando.
Esta variable, nos permitir� manejar, o al menos saber, los tipos de datos con los que estamos trabajando en un momento dado. Tambi�n pongo la declaraci�n de una variable que vamos a usar, este c�digo deber�s insertarlo en las declaraciones del m�dulo glbNotas.bas
'Tipo para los fields (campos) de la base de datos. Type Campo_t Nombre As String Tipo As Long Tama�o As Integer End Type Global Campos() As Campo_t 'Para el manejo de los campos Global sSepFecha As String 'El separador de las fechas
En el procedimiento de carga de la tabla, a�ede lo siguiente:
'... '-(10/Abr/97)- Asignamos el tama�o del array de campos ReDim Campos(j) i = -1 For Each Fd In Rs.Fields i = i + 1 '-(10/Abr/97)- Asignamos los datos de los campos With Campos(i) .Nombre = Fd.Name .Tama�o = Fd.Size .Tipo = Fd.Type End With
4.- Cambios para "detectar" los caracteres separadores en los campos de fecha.
Y ahora unas cosillas para que al escribir en un campo de
fecha, nos cambie los caracteres ".", "-" y "/" por el
separador que est� definido en el formato corto de la fecha, normalmente "/"
Primero lo "comprobaremos" para que el programa use el que est� definido, este
c�digo lo a�ades en el Form_Load.
(Seguramente habr� alguna forma
directa de obtenerlo, pero yo no la s�)
Dim sTmp As String sSepFecha = "/" sTmp = Format$(Now, "Short Date") If InStr(sTmp, "/") Then sSepFecha = "/" ElseIf InStr(sTmp, "-") Then sSepFecha = "-" 'Si usas alg�n separador "predefinido" incluyelo aqu� End If
Ahora a�ade este c�digo, para que al escribir en el TetBox, se compruebe...
Private Sub Text1_KeyPress(Index As Integer, KeyAscii As Integer) 'Comprobar si estamos en un campo de fecha 'Para los campos de fecha If Campos(Index).Tipo = dbDate Then Select Case KeyAscii Case Asc("-"), Asc("."), Asc("/") KeyAscii = Asc(sSepFecha) End Select End If End Sub
5.- El formulario para realizar las consultas.
�Ahora si! Al fin el dichoso formulario
de consulta.
Vamos a necesitar de nuevo el gsInput, as� que deber�s a�adirlo al proyecto
(gsInput.frm y gsInput.bas)
El form en el que se muestra la consulta, quedar� de la siguiente forma:
Notar�s que est� cambiado con respecto a lo que te mostr� hace un par de entregas.
Vamos a ver c�mo queda el form en el que se realizan las consultas. Este es el form gsQBE.frm
Una vez vista las "fotos" de estos dos nuevos
forms, vamos a ver el c�digo.
Primero el del formulario de consulta. Decir que este c�digo est� basado en uno que me
cre� hace un par de a�os. Lo he adaptado para usarlo en el proyecto que tenemos entre
manos, pero se puede usar m�s o menos de forma gen�rica, siempre que existan estas
variables:
---una variable llamada elForm que haga referencia al form en el que se quiere hacer la
consulta
---un array llamado Campos() del tipo t_Campo, o al menos que contengan los elementos
Tipo, Nombre y Tama�o.
---una variable sTabla con el nombre de la Tabla a consultar.
---una variable sBase con el nombre de la base de datos en la que est� esa tabla.
---y por �ltimo que la tabla tenga un campo llamado ID
Y por supuesto los forms de mostrar los datos y los gen�ricos usados en este proyecto.
Sin m�s dilaci�n, es decir: "menos rollo y m�s manteca al bollo", pasamos al "dishoso" c�digo:
'--------------------------------------------------------------- 'gsQBE Form para realizar las consultas ' '(c)Guillermo Som, 1994-97 '--------------------------------------------------------------- Option Explicit Option Compare Text Dim nOpciones As Integer 'N�mero de Opciones para 'la b�squeda y mostrar Dim MaxCampos As Integer Dim ComparaOr() As String Dim SumasCampos() As Long Dim LongCampos() As Integer Private Sub Command1_Click() 'Preparado el proceso de b�squeda: 1/Dic/94 Dim sBuscar As String Dim flag As Boolean Dim i As Integer Dim j As Integer Dim k As Integer Dim sTmp As String Dim sTmp2 As String Dim q As Integer Dim p As Integer Dim sLogico As String 'Ahora si en Text1(), se escribe | (AltGr+1), 'o [O] se har� una comparaci�n OR 'y si se empieza con [O] se hace un OR con el 'siguiente campo en vez de un AND (25/Nov/95) On Local Error Resume Next '---Asignar a sBuscar los campos y valores de la b�squeda. sBuscar = "" For i = 0 To nOpciones k = CboCampos(i).ListIndex If k >= 1 Then If cboComparaci�n(i).ListIndex < 0 Then cboComparaci�n(i).ListIndex = 0 End If j = cboComparaci�n(i).ListIndex 'Comprobar si tiene | sTmp = Trim$(Text1(i).Text) sLogico = "AND " 'Se admite [O] y [O<cualquier_cosa>] If Left$(sTmp, 2) = "[O" Then q = InStr(sTmp, "]") If q = 0 Then q = 2 sLogico = "OR " sTmp = Mid$(sTmp, q + 1) End If 'Separar en el m�smo texto con | o [O] q = InStr(sTmp, "|") If q = 0 Then q = InStr(sTmp, "[O") End If p = 0 If q Then ExtraeOpciones sTmp, q p = q End If If p Then sTmp = "" For q = 1 To p - 1 'Arreglar esto... Select Case Campos(k).Tipo Case dbByte, dbText, dbMemo sTmp = sTmp & ComparaOr(q) & "*' OR " & Campos(k).Nombre & " " & cboComparaci�n(i).List(j) & " '*" Case dbDate sTmp = sTmp & ComparaOr(q) & "') OR " & Campos(k).Nombre & " " & cboComparaci�n(i).List(j) & " Datevalue('" Case Else sTmp = sTmp & ComparaOr(q) & " OR " & Campos(k).Nombre & " " & cboComparaci�n(i).List(j) & " " End Select Next sTmp = sTmp & ComparaOr(p) End If Select Case Campos(k).Tipo Case dbByte, dbText, dbMemo 'poner '* ... *' si es Like o Not Like If InStr(cboComparaci�n(i).List(j), "Like") Then sBuscar = sBuscar & Campos(k).Nombre & " " & cboComparaci�n(i).List(j) & " '*" & CStr(sTmp) & "*' " & sLogico Else 's�lo poner '...' por si se quiere una coincidencia exacta sBuscar = sBuscar & Campos(k).Nombre & " " & cboComparaci�n(i).List(j) & " '" & CStr(sTmp) & "' " & sLogico End If Case dbDate 'poner datevalue('...') sBuscar = sBuscar & " " & Campos(k).Nombre & " " & cboComparaci�n(i).List(j) & " Datevalue('" & sTmp & "') " & sLogico Case Else 'no poner '* ... *' sBuscar = sBuscar & Campos(k).Nombre & " " & cboComparaci�n(i).List(j) & " " & sTmp & " " & sLogico End Select flag = True End If Next If Not flag Then Beep MsgBox "Se deber�a seleccionar por lo menos un campo." & Chr$(13) & "Si lo que pretendes es cancelar la b�squeda, pulsa en el bot�n de Cancelar.", 64 Exit Sub End If 'Quitarle el final sBuscar = Left$(sBuscar, Len(sBuscar) - 4) 'Guardar la selecci�n en el fichero INI GuardarQBE 'Procesar los datos de la consulta ProcesarConsulta sBuscar End Sub Private Sub Command2_Click() Unload Me End Sub Private Sub Command3_Click() '---------------------------------------------- ' Consulta directa '---------------------------------------------- sFFPoner = Trim$(LeerIni(ficIni, "General", "Buscar", "")) gsPedirUnValor "Consulta directa", "Escribe el CAMPO y la comparaci�n a usar. Ejemplo: Poblaci�n LIKE '*Nerja*'", "", sFFPoner, "Aceptar" If iFFAccion <> cFFAc_Cancelar Then If Len(sFFPoner) Then GuardarIni ficIni, "General", "Buscar", sFFPoner ProcesarConsulta sFFPoner End If Else MostrarConsulta!Command1.Caption = "" End If End Sub Private Sub ExtraeOpciones(sTmp As String, q As Integer) Dim p As Integer Dim sTmp2 As String Dim i As Integer sTmp2 = sTmp p = 0 Do q = InStr(sTmp, "|") If q Then sTmp = Mid$(sTmp, q + 1) p = p + 1 Else 'Buscar tambi�n [O q = InStr(sTmp, "[O") If q Then i = InStr(sTmp, "]") If i = 0 Then q = q + 1 sTmp = Mid$(sTmp, q + 1) p = p + 1 End If End If Loop While q If Len(Trim$(sTmp)) Then p = p + 1 End If sTmp = sTmp2 ReDim ComparaOr(p) As String p = 0 Do q = InStr(sTmp, "|") If q Then p = p + 1 ComparaOr(p) = Left$(sTmp, q - 1) sTmp = Mid$(sTmp, q + 1) Else q = InStr(sTmp, "[O") If q Then ComparaOr(p) = Left$(sTmp, q - 1) i = InStr(sTmp, "]") If i = 0 Then q = q + 1 sTmp = Mid$(sTmp, q + 1) p = p + 1 End If End If Loop While q If Len(Trim$(sTmp)) Then p = p + 1 ComparaOr(p) = sTmp End If q = p End Sub Private Sub Form_Load() Dim i As Integer Dim j As Integer Dim t As Integer Dim dBase2 Dim sTmp As String MaxCampos = UBound(Campos) Screen.MousePointer = vbHourglass Top = 0 Left = 0 'MostrarProgress "Asignando la ventana para la consulta a mostrar... " & vbCrLf 'Ahora siempre se usan Combos para seleccionar los campos 'ya que permiten hacer m�ltiples comparaciones (24/Nov/95) nOpciones = 11 Height = 1510 + (nOpciones * 430) 'Cargar los nombres de los campos... With cboComparaci�n(0) .Clear .AddItem "Like" .AddItem "Not Like" .AddItem "<" .AddItem ">" .AddItem "=<" .AddItem ">=" .AddItem "=" .AddItem "<>" End With CboCampos(0).AddItem "Ninguno" CboMostrar(0).AddItem "No Mostrar" For i = 0 To MaxCampos With Campos(i) CboCampos(0).AddItem .Nombre CboMostrar(0).AddItem .Nombre End With Next Text1(0).Text = "" CboCampos(0).Top = cboComparaci�n(0).Top CboCampos(0).Visible = True CboMostrar(0).Top = cboComparaci�n(0).Top CboMostrar(0).Visible = True For i = 1 To nOpciones Load cboComparaci�n(i) Load Text1(i) Load CboCampos(i) Load CboMostrar(i) For j = 0 To cboComparaci�n(0).ListCount - 1 cboComparaci�n(i).AddItem cboComparaci�n(0).List(j) Next For j = 0 To CboCampos(0).ListCount - 1 CboCampos(i).AddItem CboCampos(0).List(j) CboMostrar(i).AddItem CboMostrar(0).List(j) Next cboComparaci�n(i).Top = cboComparaci�n(i - 1).Top + cboComparaci�n(i - 1).Height + 75 cboComparaci�n(i).Visible = True CboCampos(i).Top = cboComparaci�n(i).Top CboCampos(i).Visible = True CboMostrar(i).Top = cboComparaci�n(i).Top CboMostrar(i).Visible = True Text1(i).Top = cboComparaci�n(i).Top Text1(i).Visible = True Text1(i).Text = "" Next 'Poder recuperar la �ltima consulta... For i = 0 To nOpciones sTmp = "OpCampo" & RTrim$(Str$(i)) CboCampos(i).ListIndex = LeerIni(ficIni, "QBE_" & sUsuario, sTmp, 0) sTmp = "OpComparacion" & RTrim$(Str$(i)) cboComparaci�n(i).ListIndex = LeerIni(ficIni, "QBE_" & sUsuario, sTmp, 0) sTmp = "OpTexto" & RTrim$(Str$(i)) Text1(i).Text = LeerIni(ficIni, "QBE_" & sUsuario, sTmp, "") sTmp = "OpMostrar" & RTrim$(Str$(i)) CboMostrar(i).ListIndex = LeerIni(ficIni, "QBE_" & sUsuario, sTmp, 0) Next 'Poner en orden las tabulaciones... For i = nOpciones To 0 Step -1 CboCampos(i).TabIndex = 0 Text1(i).TabIndex = 0 cboComparaci�n(i).TabIndex = 0 CboMostrar(i).TabIndex = 0 Next Command3.TabIndex = 0 Command2.TabIndex = 0 Command1.TabIndex = 0 Command1.Top = ScaleHeight - 510 Command2.Top = Command1.Top Command3.Top = Command1.Top Label1(4).Top = Command1.Top + 45 Screen.MousePointer = vbDefault End Sub Private Sub GuardarQBE() Dim i As Integer Dim sValor As String Dim sTmp As String 'Guardar la �ltima consulta... For i = 0 To nOpciones sTmp = "OpCampo" & RTrim$(Str$(i)) sValor = Str$(CboCampos(i).ListIndex) GuardarIni ficIni, "QBE_" & sUsuario, sTmp, sValor sTmp = "OpComparacion" & RTrim$(Str$(i)) sValor = Str$(cboComparaci�n(i).ListIndex) GuardarIni ficIni, "QBE_" & sUsuario, sTmp, sValor sTmp = "OpTexto" & RTrim$(Str$(i)) sValor = Text1(i).Text GuardarIni ficIni, "QBE_" & sUsuario, sTmp, sValor sTmp = "OpMostrar" & RTrim$(Str$(i)) sValor = Str$(CboMostrar(i).ListIndex) GuardarIni ficIni, "QBE_" & sUsuario, sTmp, sValor Next End Sub Private Sub Form_Unload(Cancel As Integer) Set gsQBE = Nothing End Sub Private Sub Label1_Click(Index As Integer) Dim msg As String If Index = 4 Then msg = "CONSEJOS PARA USAR LA OPCI�N DE B�SQUEDA" & vbCrLf & vbCrLf msg = msg & "Selecciona los campos de b�squeda, la comparaci�n, " msg = msg & "el texto a comparar y los campos que quieres mostrar." & vbCrLf msg = msg & "Por defecto se hace una b�squeda selectiva, es decir deben coincidir " msg = msg & "todos los campos especificados con la comparaci�n que se hace." & vbCrLf msg = msg & "Aunque se puede hacer una b�squeda opcional, (no selectiva): " msg = msg & "no tienen porqu� coincidir todos los campos, sino que se puede " msg = msg & "buscar por conceptos distintos, m�s abajo hay varios ejemplos." & vbCrLf msg = msg & "Las comparaciones que se pueden hacer son: " & vbCrLf msg = msg & " LIKE Igual" & vbCrLf msg = msg & "NOT LIKE Distinto (no igual)" & vbCrLf msg = msg & " > Mayor" & vbCrLf msg = msg & " < Menor" & vbCrLf msg = msg & " >= Mayor o igual" & vbCrLf msg = msg & " <= Menor o igual" & vbCrLf msg = msg & " = Igual" & vbCrLf msg = msg & " <> Distinto" & vbCrLf msg = msg & "La diferencia entre 'LIKE'/'NOT LIKE' y '='/'<>' " msg = msg & "es que con los LIKE se pueden usar los comodines: * ? #" & vbCrLf msg = msg & "-- ? un caracter cualquiera" & vbCrLf msg = msg & "-- # un d�gito (n�mero)" & vbCrLf msg = msg & "-- * cualquier cantidad de caracteres" & vbCrLf msg = msg & "Ejemplos:" & vbCrLf msg = msg & "-- M* todos los registros que en el campo especificado, empiecen por M" & vbCrLf msg = msg & "-- *M* que tenga una M" & vbCrLf msg = msg & "-- A?C cualquier secuencia que empiece con A y termine con C: ABC, AAC, etc." & vbCrLf msg = msg & vbCrLf & "IMPORTANTE: Por defecto, para los campos de texto, lo que se escriba en la casilla " msg = msg & "del texto a buscar, se pone entre dos *, de esta forma se buscar� " msg = msg & "cualquier registro que tenga ese texto escrito; por tanto el uso del " msg = msg & "comod�n * no tiene actualmente ning�n significado, en el futuro " msg = msg & "es posible que haya que expecificarlo, pero por ahora no es necesario." & vbCrLf & vbCrLf msg = msg & "En CONSULTA DIRECTA si se puede especificar este comod�n, (m�s abajo se explica como usar la Consulta Directa)." & vbCrLf & vbCrLf msg = msg & "En una misma casilla de texto, se pueden especificar varias palabras, " msg = msg & "separando cada palabra con: " & vbCrLf msg = msg & "| (AltGr+1) o con [O]" & vbCrLf msg = msg & "Ejemplo: para buscar la palabra CASA o CHALET, escribir�amos: " msg = msg & "CASA|CHALET o bien CASA[O]CHALET" & vbCrLf msg = msg & "Veamos varios ejemplos:" & vbCrLf msg = msg & "Buscar las fechas iguales a 4/11/95 o 7/11/95" & vbCrLf msg = msg & " COMPARACI�N TEXTO" & vbCrLf msg = msg & " = 04/11/95|07/11/95" & vbCrLf msg = msg & "Buscar las fechas mayores al 10/11/95" & vbCrLf msg = msg & " > 10/11/95" & vbCrLf msg = msg & "Cuidado cuando se especifican varias comparaciones ya " msg = msg & "que puede que se pidan cosas imposibles:" & vbCrLf msg = msg & "Si estos dos ejemplos se especifican en la m�sma " msg = msg & "b�squeda, no mostrar�a nada, ya que se le dice:" & vbCrLf msg = msg & " Todas las fechas que sean iguales al 4 de nov" & vbCrLf msg = msg & " 'O' iguales al 7 de nov" & vbCrLf msg = msg & " 'Y' que sean mayores al 10 de nov" & vbCrLf msg = msg & "la verdad es que no se cumplir�a esa comparaci�n, " msg = msg & "ya que no puede ser igual al 4 nov y tambi�n mayor que el 10 nov." & vbCrLf msg = msg & "El error est� en pensar que se har�a de esta forma:" & vbCrLf msg = msg & " Todas las fechas que sean iguales al 4 de nov" & vbCrLf msg = msg & " 'O' iguales al 7 de nov" & vbCrLf msg = msg & " 'Y' LAS que sean mayores al 10 de nov" & vbCrLf & vbCrLf msg = msg & "Es importante tener en cuenta, como apunt� al principio, que siempre que se " msg = msg & "comparan varios campos (o uno en distintas " msg = msg & "l�neas) se hace un 'Y', es decir que se tienen que " msg = msg & "cumplir todas las comparaciones, (comparaci�n selectiva)." & vbCrLf msg = msg & "Para cambiar el 'Y' por un 'O' (comparaci�n opcional), " msg = msg & "escribir [O] en el campo anterior al que se quiere aplicar." & vbCrLf msg = msg & "En el ejemplo anterior, escribir�amos en el primer campo:" & vbCrLf msg = msg & " COMPARACI�N TEXTO" & vbCrLf msg = msg & " = [O]04/11/95|07/11/95" & vbCrLf msg = msg & "en el segundo:" & vbCrLf msg = msg & " > 10/11/95" & vbCrLf msg = msg & "Se mostrar�an todas las fechas:" & vbCrLf msg = msg & " iguales al 4 nov" & vbCrLf msg = msg & " 'O' igual al 7 nov" & vbCrLf msg = msg & " 'O' mayor al 10 nov" & vbCrLf msg = msg & "NOTA: Cuando se usan fechas, hay que tener en cuenta el formato usado, es decir si se deben especificar o no los ceros delante de los n�meros. Por regla general, deben especificarse." & vbCrLf msg = msg & "En caso de textos:" & vbCrLf msg = msg & "Buscar todos los JUAN 'O' los que viven en NERJA" & vbCrLf msg = msg & " CAMPO COMPARACI�N TEXTO" & vbCrLf msg = msg & " Nombre Like [O]Juan" & vbCrLf msg = msg & " Poblaci�n Like Nerja" & vbCrLf & vbCrLf msg = msg & "COMO USAR LA CONSULTA DIRECTA:" & vbCrLf msg = msg & "En la consulta directa se debe especificar el o los campos a comparar y la comparaci�n a realizar: " & vbCrLf msg = msg & "Para eso es necesario saber como se llama el campo que se quiere comparar, " msg = msg & "la lista de los nombres de los campos sale en la ventana de la opci�n de configuraci�n, " msg = msg & "por defecto las etiquetas informativas de la pantalla principal o las listas de los nombres " msg = msg & "de los campos que aparecen en esta opci�n de b�squeda, son los nombres de " msg = msg & "los campos, salvo que se hayan cambiado con la opci�n de Configuraci�n." & vbCrLf msg = msg & "En la consulta directa no se permite usar | ni [O]" & vbCrLf msg = msg & "Ejemplo: Buscar todos los JUAN 'O' los que viven en NERJA" & vbCrLf msg = msg & "Se har� de esta forma:" & vbCrLf msg = msg & "Nombre LIKE '*Juan*' OR [Poblaci�n] LIKE '*Nerja*'" & vbCrLf msg = msg & "Para buscar todos los registros que en el campo Nombre tengan Juan " msg = msg & "y la Fecha sea superior al 10/11/95:" & vbCrLf msg = msg & "Nombre LIKE '*Juan*' OR Fecha > DATEVALUE('10/11/95')" & vbCrLf msg = msg & "Como se puede ver, la Consulta Directa es m�s complicada de usar y est� " msg = msg & "s�lo para usarla si se sabe lo que se quiere hacer o para especificar otras " msg = msg & "opciones que no est�n contempladas en la b�squeda normal." & vbCrLf msg = msg & "El lenguaje que se usa es SQL (Structured Query Lenguage) " msg = msg & "y la instrucci�n que se hace es:" & vbCrLf msg = msg & "SELECT * FROM " & sTabla & " WHERE <b�squeda> ORDER BY ID" & vbCrLf msg = msg & "<b�squeda> es el texto que se escribe." & vbCrLf msg = msg & "Los datos mostrados, ser�n los que se especifiquen en los campos a mostrar, al igual que en la consulta normal." & vbCrLf & vbCrLf msg = msg & "IMPORTANTE: En estas rutinas de b�squeda no se hace distinci�n entre may�sculas y min�sculas." msg = msg & vbCrLf & vbCrLf & "[FIN DEL MENSAJE DE AYUDA]" If MsgConfirm(msg) Then End If msg = "" End If End Sub Private Sub ProcesarConsulta(sBuscar As String) Dim Db As Database Dim strCampos As String Dim SQLtmp As String Dim MySnap As Recordset Dim i As Integer Dim flag As Integer Dim j As Integer Dim k As Integer Dim sTmp As String Dim sTmp2 As String Dim q As Integer Dim p As Integer Dim sLogico As String Dim iLongCampo As Integer ReDim LongCampos(MaxCampos) On Local Error Resume Next Screen.MousePointer = vbHourglass 'Abrir la base... Set Db = OpenDatabase(sBase) 'Ejecutar orden SQL con los datos solicitados SQLtmp = "select * from " & sTabla & " where " & sBuscar & " order by ID" Set MySnap = Db.OpenRecordset(SQLtmp, dbOpenSnapshot) MySnap.MoveFirst If Err Then Err = 0 'no hay datos, avisar MsgBox "No hay datos que coincidan con la b�squeda especificada.", 64 cboComparaci�n(0).SetFocus Screen.MousePointer = vbDefault Exit Sub End If Load MostrarConsulta MostrarConsulta!List1.Clear strCampos = "" 'A�adir los nombres de los "campos" a mostrar For i = 0 To nOpciones k = CboMostrar(i).ListIndex If k >= 1 Then If Campos(k - 1).Tipo = dbLong Then LongCampos(k - 1) = 12 ElseIf Campos(k - 1).Tipo = dbText Then LongCampos(k - 1) = Campos(k - 1).Tama�o If LongCampos(k - 1) > 30 Then LongCampos(k - 1) = 30 End If Else LongCampos(k - 1) = 8 End If strCampos = strCampos & Left$(Trim$(Campos(k - 1).Nombre) & Space$(LongCampos(k - 1)), LongCampos(k - 1)) & ", " End If Next With MostrarConsulta .List1.AddItem strCampos .List1.ItemData(.List1.NewIndex) = -1 .List1.AddItem String$(Len(strCampos), "-") .List1.ItemData(.List1.NewIndex) = -1 End With flag = False MySnap.MoveFirst Do Until MySnap.EOF DoEvents strCampos = "" For i = 0 To nOpciones k = CboMostrar(i).ListIndex - 1 If k >= 0 Then flag = True iLongCampo = LongCampos(k - 1) strCampos = strCampos & Left$(Trim$(MySnap(Campos(k - 1).Nombre) & " ") & Space$(iLongCampo), iLongCampo) & ", " If Err Then strCampos = strCampos & Left$("���ERROR!!!" & Space$(iLongCampo), iLongCampo) & ", " Err = 0 End If End If Next MostrarConsulta!List1.AddItem strCampos MostrarConsulta!List1.ItemData(MostrarConsulta!List1.NewIndex) = MySnap("ID") MySnap.MoveNext Loop If Not flag Then 'no hay datos, avisar MsgBox "No hay datos que coincidan con la b�squeda especificada.", 64 cboComparaci�n(0).SetFocus Screen.MousePointer = vbDefault Exit Sub End If Screen.MousePointer = vbDefault Unload Me End Sub
Ahora le toca el turno al form de mostrar los datos.
'--------------------------------------------------------------- ' Para mostrar los datos de la consulta ' '(c)Guillermo Som, 1994-97 '--------------------------------------------------------------- Option Explicit Dim EstaImprimiendo As Integer Dim CancelarImpresion As Integer Private Sub CmdBuscar_Click() Hide gsQBE.Show vbModal If MostrarConsulta!Command1.Caption = "" Then Unload MostrarConsulta Else MostrarConsulta.Show End If End Sub Private Sub CmdEditar_Click() Dim registro As Long If List1.ListIndex < 0 Then 'No ha registro seleccionado MsgBox "Debes seleccionar de la lista el registro a mostrar.", 48 Else registro = List1.ItemData(List1.ListIndex) If registro > 0 Then With elForm .Data1.Recordset.FindFirst "ID = " & registro If .Data1.Recordset.EOF Then Beep MsgBox "Ese registro no ha sido hallado " & registro .Data1.Recordset.MoveFirst Else .Show End If End With Unload Me End If End If End Sub Private Sub CmdImprimir_Click() Dim nFicSal As Integer Dim sLPT As String Dim i As Integer Dim j As Integer Dim sTmp As String Dim sImpresora As String Dim k As Integer Dim sngFS As Single Dim sFN As String On Local Error GoTo ErrorImprimiendo If EstaImprimiendo Then CancelarImpresion = True Command1.Enabled = True CmdBuscar.Enabled = True CmdImprimir.Caption = "Imprimir" Else '--- Para leer del Win.ini 'sTmp = GetSetting("win.ini", "windows", "device", "") 'sLPT = "LPT1" 'sImpresora = "Impresora desconocida" 'If Len(sTmp) Then ' i = InStr(sTmp, ",") ' If i Then ' sImpresora = Left$(sTmp, i - 1) ' sTmp = Mid$(sTmp, i + 1) ' 'Quitar el nombre del controlador... ' i = InStr(sTmp, ",") ' If i Then ' sTmp = Mid$(sTmp, i + 1) ' End If ' i = InStr(sTmp, ":") ' If i Then ' sLPT = Left$(sTmp, i - 1) ' End If ' End If 'End If '--- sImpresora = Printer.DeviceName sLPT = Printer.Port If Right$(sLPT, 1) = ":" Then sLPT = Left$(sLPT, Len(sLPT) - 1) End If sTmp = "Para imprimir los datos en:" & Chr$(13) & sImpresora & " en " & sLPT & Chr$(13) & "Pulsa:" & Chr$(13) sTmp = sTmp & "Si: para usar el controlador de Windows." & Chr$(13) sTmp = sTmp & "No: para imprimir directamente, en letra peque�a." & Chr$(13) sTmp = sTmp & "Cancelar: para no imprimir." 'Imprimir los datos... i = MsgBox(sTmp, 32 + 3, "Imprimir datos") EstaImprimiendo = True Command1.Enabled = False CmdBuscar.Enabled = False CmdImprimir.Caption = "Cancelar Impresi�n" sTmp = Caption k = List1.ListCount If i = 6 Then 'Usar controlador de Windows sngFS = Printer.FontSize sFN = Printer.FontName If MsgBox("�Quieres Imprimir con Courier New 9 puntos?", 4 + 32, "Imprimir") = 6 Then Printer.FontSize = 9 Printer.FontName = "Courier New" End If Printer.Print "" Printer.Print "" For i = 0 To k - 1 DoEvents If CancelarImpresion Then Exit For Caption = "Imprimiendo " & i + 1 & " de " & k Printer.Print Left$(List1.List(i), 132) Next Printer.EndDoc Printer.FontSize = sngFS Printer.FontName = sFN ElseIf i = 7 Then 'Imprimir directamente... j = 0 nFicSal = FreeFile Open sLPT For Output As nFicSal Print #nFicSal, Chr$(15); 'Letra peque�a For i = 0 To k - 1 DoEvents If CancelarImpresion Then Exit For Caption = "Imprimiendo " & i + 1 & " de " & k Print #nFicSal, Left$(List1.List(i), 136) j = j + 1 If j = 50 Then Print #nFicSal, Chr$(12); j = 0 End If Next If j Then Print #nFicSal, Chr$(12); End If Print #nFicSal, Chr$(18); Close nFicSal End If Caption = sTmp EstaImprimiendo = False CancelarImpresion = False Command1.Enabled = True CmdBuscar.Enabled = True CmdImprimir.Caption = "Imprimir" End If Exit Sub ErrorImprimiendo: MsgBox "Se ha producido el error" & Chr$(13) & Error$(Err) & Chr$(13) & "al intentar imprimir." Caption = sTmp EstaImprimiendo = False CancelarImpresion = False Command1.Enabled = True CmdBuscar.Enabled = True CmdImprimir.Caption = "Imprimir" Exit Sub End Sub Private Sub Command1_Click() Unload Me End Sub Private Sub Form_Activate() Const LB_SETHORIZONTALEXTENT = &H400 + 21 Const NULO = &O0 Dim ListhWnd Dim ListLen Dim iTmp Dim ScaleTmp As Integer 'Mostrar el n�mero de datos hallados Caption = "Resultado de la b�squeda: " & List1.ListCount - 4 & " datos" 'Poner un scroll horizontal al ListBox ScaleTmp = ScaleMode ListhWnd = List1.hWnd ScaleMode = 3 ListLen = 4000 iTmp = SendMessage(ListhWnd, LB_SETHORIZONTALEXTENT, ListLen, NULO) ScaleMode = ScaleTmp End Sub Private Sub Form_Load() 'Posicionarla en la parte superior izquierda Top = 0 Left = 0 End Sub Private Sub Form_Resize() If WindowState <> 1 Then Command1.Top = ScaleHeight - Command1.Height - 120 CmdImprimir.Top = Command1.Top CmdBuscar.Top = Command1.Top cmdEditar.Top = Command1.Top List1.Move 90, 90, ScaleWidth - 180, Command1.Top - 180 End If End Sub
6.- Para Rematar.
Bueno, creo que ya est� la cosa m�s lograda. Por supuesto hay que a�adir al men� archivo la opci�n de consulta, si no se hace, �c�mo vas a ejecutarla? La forma de llamar a esta ventana es la siguiente:
Private Sub mnuConsulta_Click() gsQBE.Show vbModal If MostrarConsulta!Command1.Caption = "" Then Unload MostrarConsulta Else MostrarConsulta.Show End If End Sub
Ya est� bien por hoy. Sigue atento a esta pantalla, para ver cuando es la pr�xima entrega...
Nos vemos. (...pronto espero.)