Option Explicit
Public bool As Boolean
Public bool2 As Boolean
Public auxi_grid As String
Public pasar_id As Integer
Public Numero As Integer
Public ident As Integer
Public auxi As Integer
Public copia_id As Integer
Public copia_nombre As String
Public copia_descripcion As String
Public copia_solucion_1 As String
Public cn As ADODB.Connection
Public rst As ADODB.Recordset
Sub Conectar()
' Crea una nueva conexión y un recordset
Set cn = CreateObject("ADODB.Connection")
Set rst = CreateObject("ADODB.Recordset")
rst.CursorLocation = adUseClient
' abre la base de datos DIRECCION ANTERIOR
' cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data " & _
' "Source=C:Program FilesMicrosoft " & _
' "Visual StudioVB98SISTEMA BUSQUEDAAplicacion.MDB;Persist Security Info=False"
'DIRECCION NUEVA DEL SERVIDOR \XOA008
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data " & _
"Source=\Xoa008COMPARTIDO SISTEMASSistema " & _
"de Registro & Solución de ProblemasBase de DatosAplicacion.MDB;Persist Security Info=False"
End Sub
Sub Desconectar()
'MOSTRAR LA LISTA DE SOLUCIONES EN TEXT3.TEX
' Form6.Text3.Text = rst("Solucion_1")
'*******************************************
rst.Close
cn.Close
Set rst = Nothing
Set cn = Nothing
End Sub
Private Sub Combo1_Click()
Call Conectar
rst.Open "SELECT ID,Nombre,Descripcion FROM TablaAplicacion WHERE Nombre Like '%" & _
Combo1.Text & "%'", cn, adOpenStatic, adLockOptimistic
' Muestra los datos en el FlexGrid
Set MSHFlexGrid1.DataSource = rst
' Visualiza la cantidad de registros filtrados
Me.Caption = "Peugeot - Registros encontrados: " & CStr(rst.RecordCount)
'REVISA ESTE CAMBIO !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
'POSIBILIDAD PARA EVITAR QUE SE MANTENGA SELECCIONADA UNA CELDA Y
'ASI EVITAR QUE SE CORRA EL REGISTRO
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
MSHFlexGrid1.FocusRect = flexFocusHeavy
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Call Desconectar
End Sub
Private Sub Command1_Click()
'MARZO 5 - EVITAR ERROR AL PULSAR GUARDAR CON CAMPOS EN BLANCO
'MARZO 9 - CAMBIOS REALIZADOS PARA SOLO GUARDAR LA SOLUCION
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
If Text6.Text = "" Then
'If Text3.Text = "" And Text5.Text = "" And Text6.Text = "" And Combo2.Text = "" Then
MsgBox ("No hay Datos para Modificar.")
Else
Call Conectar
rst.Open "SELECT ID,Nombre,Descripcion,Solucion_1 FROM TablaAplicacion WHERE ID Like '%" & _
Text4.Text & "%'", cn, adOpenStatic, adLockOptimistic
If rst.EOF = True Then
Beep
Else
Do While bool2 = False
If rst.Fields("ID") = pasar_id Then
'rst.Fields("Nombre") = Combo2.Text
'rst.Fields("Descripcion") = Text5.Text
rst.Fields("Solucion_1") = Text6.Text
rst.Update
MsgBox ("Se han guardado los cambios.")
bool2 = True
Command3.Enabled = False
Else
rst.MoveNext
End If
Loop
End If
rst.MoveFirst
Call Desconectar
bool2 = False
MSHFlexGrid1.Clear
Command1.Enabled = False
Command4.Enabled = False
End If
'Call copy_auxi
End Sub
Private Sub Command2_Click()
'MARZO 5 - LIMPIEZA AL SALIR DE EDITAR/BORRAR
'MARZO 9 - CAMPOS NO NECESARIOS TEXT3,5 Y COMBO2
MSHFlexGrid1.Clear
MSHFlexGrid1.Refresh
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
'**********************Text4.Text = ""
'Text5.Text = ""
Text6.Text = ""
Combo1.Text = ""
'Combo2.Text = ""
Form9.Hide
Form1.Show
End Sub
Private Sub Command3_Click()
'AGREGADO DEL 5 DE MARZO
'MARZO 9 - CAMPOS INNECESARIOS
'Combo2.Text = copia_nombre
'Text5.Text = copia_descripcion
Text6.Text = copia_solucion_1
'Call local_clear_auxi
End Sub
Private Sub Command4_Click()
'On Error Resume Next
'Se utiliza la línea On Error Resume Next para indicarle a Visual Basic que siga ejecutando
'la forma, aún cuando ocurra un error de ejecución
Call Conectar
rst.Open "SELECT ID,Nombre,Descripcion,Solucion_1 FROM TablaAplicacion WHERE ID Like '%" & _
Text4.Text & "%'", cn, adOpenStatic, adLockOptimistic
If rst.EOF = True Then
Beep
Else
Do While bool2 = False
'Do Until bool2 = True
If rst.Fields("ID") = pasar_id Then '¿¿¿¿¿¿ crear variable para copiar
'MARZ0 5 MIDIFICADO
'rst.Fields("Nombre") = Combo2.Text
'rst.Fields("Descripcion") = Text5.Text
'rst.Fields("Solucion_1") = Text6.Text
If MsgBox("Se va a eliminar el Registro, ¿Desea continuar?", vbExclamation + vbYesNo, "Eliminacion de Registros") = vbYes Then
rst.Delete
rst.Requery
rst.MoveNext
'POSIBILIDAD PARA EVITAR QUE AL ELIMINAR N REGISTRO DESPLIEGUE DATOS ANTES DEL BORRADO
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'PARA EVITAR QUE AL ELIMINAR EL CURSOR DESPLIEGUE EL MISMO REGISTRO ELIMINADO
'A PESAR DE QUE EL RECORDSET YA AVANZO
'CALCULAR EL AVANCE DEL RECORSET
' Text3.Text = rst.Fields("ID")
' Combo2.Text = rst.Fields("Nombre")
' Text5.Text = rst.Fields("Descripcion")
' Text6.Text = rst.Fields("Solucion_1")
' If rst.EOF Then
' rst.MoveLast
' End If
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
MsgBox ("Registro Eliminado con Éxito.")
'EVITA QUE DESPLIEGUE OTROS REGISTROS DESPUES DE ELIMINAR UNO++++++
'MARZO 9 - CAMPOS INNECESARIOS
Text3.Text = ""
'Combo2.Text = ""
'Text5.Text = ""
Text6.Text = ""
Command3.Enabled = False
Command4.Enabled = False
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
bool2 = True
MSHFlexGrid1.Clear
'DESPLEGAR VALORES EN TABLA SEGUN APLICACION AL BORRAR
'+++++++++++++++++++++++++++++++++++++++++++++++++++++
Call Desconectar
Call Conectar
rst.Open "SELECT ID,Nombre,Descripcion FROM TablaAplicacion WHERE Nombre Like '%" & _
Combo1.Text & "%'", cn, adOpenStatic, adLockOptimistic
Set MSHFlexGrid1.DataSource = rst
'+++++++++++++++++++++++++++++++++++++++++++++++++++++
Else
MsgBox ("El Registro No fue Eliminado.")
bool2 = True
Command4.Enabled = False
End If
Else
rst.MoveNext
End If
Loop
End If
'COMENTAR PARA EVITAR QUE AL BORRAR ENVIE Y DESPLIEGUE AL PRIMER REGISTRO
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'rst.MoveFirst
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'Command4.Enabled = False
Call Desconectar
bool2 = False
'///////////////////////////////
End Sub
Private Sub Form_Load()
MSHFlexGrid1.Clear
With MSHFlexGrid1
.SelectionMode = flexSelectionByRow
.FixedCols = 0
.ColWidth(0) = 700
.ColWidth(1) = 2000
.ColWidth(2) = 5000
' .ColWidth(3) = 4000
' .ColWidth(4) = 4000
End With
Text2.Text = ""
Text3.Text = ""
End Sub
Private Sub MSHFlexGrid1_Click()
'///////////////////////////////////////////////////////////////////
'CAMBIAR CADENAS STRING A INTEGER
'Dim Cadena As String, Numero As Integer
'Cadena = "12345.25"
'Numero = CInt(Val(Cadena)) 'Esto te cambia la cadena a un numero entero
Text1.Text = MSHFlexGrid1.Text
auxi_grid = MSHFlexGrid1.Text
Numero = CInt(Val(auxi_grid))
Text4.Text = Numero
Form7.Text1.Text = ""
'ENABLE EL BOTON DESHACER CUANDO SE HACE CLICK EN TABLA
'OTRA OPCION SERIA ELIMINAR EL BOTON - SERIA MEJOR OPCION
' PERMITIR MODIFICAR SOLO EL CAMPO SOLUCION
Command3.Enabled = True
Command4.Enabled = True
Command1.Enabled = True
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Call Conectar
'CAMBIOS NUEVOS agregamos Solucion
rst.Open "SELECT ID,Nombre,Descripcion,Solucion_1 FROM TablaAplicacion WHERE ID Like '%" & _
Text4.Text & "%'", cn, adOpenStatic, adLockOptimistic
' Para acceder a un campo:
If rst.EOF = True Then
Form7.Text1.Text = ""
Else
'CAMBIOS NUEVOS Adodc1.RecordSource = "SELECT * FROM TablaAplicacion"
'CAMBIOS NUEVOS Adodc1.Refresh
'/// With Adodc1.Recordset
'/// If .EOF And .BOF Then
'/// auxi = 0
'/// Else
If MSHFlexGrid1.Text = "" Then
MsgBox "La Tabla esta Vacia"
Else
Do While bool = False
'PREGUNTAR SI HAY UN EOF O BOF PARA CUANDO NO HAY REGISTROS EN LA OPCION
'Y HACEN CLICK
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
If rst.BOF = True Or rst.EOF = True Then
MsgBox ("No existen registros de esta Aplicación.")
bool = True
Else
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
If rst.Fields("ID") = Text4.Text Then
Text3.Text = ""
'Combo2.Text = ""
'Text5.Text = ""
Text6.Text = ""
'CAMBIOS 9 DE MARZO, SE BORRAN LOS CAMPOS DE ID,NOMBRE Y DESCRIPCION
'YA QUE SOLO SE DESEA MODIFICAR SOLUCION
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Text3.Text = rst.Fields("ID")
'Combo2.Text = rst.Fields("Nombre")
'Text5.Text = rst.Fields("Descripcion")
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Text6.Text = rst.Fields("Solucion_1")
bool = True
pasar_id = rst.Fields("ID")
'CAMBIO RECIENTE HOY 5 MARZO
Call local_clear_auxi
Call local_copy_auxi
Else
'CAMBIOS NUEVOS Adodc1.Recordset.MoveNext
rst.MoveNext
End If
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
End If
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Loop
End If
'/// End If
'/// End With
'CAMBIOS NUEVOS Adodc1.Recordset.MoveFirst 'CAMBIO RECIENTE
End If
rst.MoveFirst
Call Desconectar
auxi_grid = ""
Numero = 0
Text4.Text = ""
bool = False
End Sub
Private Sub Text1_GotFocus()
'Text1.Text = ""
End Sub
Private Sub Text2_Change()
' conecta
Call Conectar
bool = False
' Ejecuta la consulta SQL
'SENTENCIA SQL ORIGINAL
' rst.Open "SELECT ID,Nombre,Descripcion FROM TablaAplicacion WHERE Descripcion Like '%" & _
' Text2.Text & "%'", cn, adOpenStatic, adLockOptimistic
rst.Open "SELECT ID,Nombre,Descripcion FROM TablaAplicacion WHERE Descripcion Like '%" & Text2.Text & "%' And Nombre Like '" & Combo1.Text & "'", cn, adOpenStatic, adLockOptimistic
' ' Para acceder a un campo:
If rst.EOF = True Then
' Text3.Text = "" borrar text1
Text1.Text = ""
Else
'ULTIMA MODIFICIACION ADODC******************************************************
ident = rst("ID")
Adodc1.RecordSource = "SELECT * FROM TablaAplicacion"
Adodc1.Refresh
Do While bool = False
If Adodc1.Recordset.Fields("ID") = ident Then
'Text3.Text = Adodc1.Recordset.Fields("Solucion_1")
'IMPRIME SOLUCION EN TEXT3.TEXT CUANDO FILTRAS INFO
bool = True
Else
Adodc1.Recordset.MoveNext
End If
Loop
'*******************************************************************************
' GOOD Text3.Text = rst("Solucion_1")
End If
' Enlaza el FlexGRid
Set MSHFlexGrid1.DataSource = rst
' Cantidad de registros
Me.Caption = "Registros encontrados: " & CStr(rst.RecordCount)
' Desconecta de la base de datos
Call Desconectar
If Text2.Text = "" Then
'Text3.Text = "" borrar text1
Text1.Text = ""
End If
End Sub
Private Sub Text2_GotFocus()
Text2.Text = ""
End Sub
''MODIFICACION RECIENTE 5 de marzo////////////////////////////////////////////
' COPIA VARIABLES AUXI PARA BOTON DESHACER
' NO COPIAR VALORES NO NECESARIOS
Private Sub local_copy_auxi()
'copia_id = TxtID.Text
'copia_nombre = Combo2.Text
'copia_descripcion = Text5.Text
copia_solucion_1 = Text6.Text
End Sub
Private Sub local_clear_auxi()
copia_id = 0
'copia_nombre = ""
'copia_descripcion = ""
copia_solucion_1 = ""
End Sub