Hola!. Soy nuevo en este mundo y tengo mis dudas y mis problemas. Estoy haciendo un programa en Visual Basic donde hay un listview, una base de datos ADO, botones de ordenar, buscar, eliminar,agregar y modificar. El problema que tengo es que no puedo ni buscar, ni ordenar, ni eliminar, ni agregar ni modificar. En una palabra, lo unico que tengo es que se muestra los datos de la base de datos en el listview.
Este es el formulario principal:
Código:
Option Explicit
' Botones de opción
''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub cmdOpciones_Click(Index As Integer)
Select Case Index
Case 0: Call Agregar
Case 1: Call editar
Case 2: Call Eliminar
Case 3: Unload Me
Case 4: buscar.Show , Me
Case 5: Call mnuImprimir_Click
End Select
End Sub
'Abre el formulario para Editar el registro seleccionado en el ListView
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub editar()
' verifica que hay datos en el ListView y que hay uno seleccionado
If (lv.ListItems.Count = 0) Then
MsgBox "No hay ningún registro para editar", vbInformation
Exit Sub
End If
If (lv.SelectedItem Is Nothing) Then
MsgBox "Debe seleccionar previamente un registro para poder editarlo", vbInformation
Exit Sub
End If
With editar
' obtiene el elemento seleccionado
.lblID = lv.SelectedItem.Text
For i = 1 To 4
.Text1(i).Text = lv.SelectedItem.ListSubItems(i).Text
Next
.ACCION = EDITAR_REGISTRO
.Show vbModal
End With
End Sub
' Elimina el registro actual seleccionado
'''''''''''''''''''''''''''''''''''''''''''''
Private Sub Eliminar()
Dim nc As String
nc = InputBox(" Escriba el número de cliente a eliminar. Esta acción es irreversible. ", " Eliminar ")
If nc <> vbNullString Then
'Ejecuta la sentencia SQL de eliminación
cnn.Execute "DELETE FROM Clientes WHERE Nombre = '" & nc & "'"
End If
End Sub
Sub Agregar()
' Acción
editar.ACCION = AGREGAR_REGISTRO
' Abre el Form
editar.Show 1
End Sub
Sub Salir()
Call Desconectar
Unload Me
End
End Sub
Private Sub Form_Load()
' Abre la conexión
Call IniciarConexion
' carga el Recorset con todos los datos
rs.Open "select * from Clientes", cnn, adOpenStatic, adLockOptimistic
' llena el ListView
Call CargarListView(lv, rs)
End Sub
Private Sub lv_DblClick()
Call editar
End Sub
Private Sub lv_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Dim Item As ListItem
Set Item = lv.HitTest(x, y)
If Not Item Is Nothing And Button = vbRightButton Then
Item.Selected = True
Me.PopupMenu mnuEdicion
End If
End Sub
' menues
'''''''''''''''''''''''''''''
Private Sub mnuAgregar_Click()
Call Agregar
End Sub
Private Sub mnuEditar_Click()
Call editar
End Sub
Private Sub mnuEliminar_Click()
Call Eliminar
End Sub
' salir
''''''''''''''''''''''''
Private Sub mnuSalir_Click()
Call Salir
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Dim ret As VbMsgBoxResult
ret = MsgBox("¿Salir?", vbInformation + vbYesNo)
If ret = vbNo Then
Cancel = True
Else
Call Salir
End If
End Sub
Siempre me salta este error al eliminar
-2747217904
El formulario de buscar y ordenar:
Código:
Option Explicit
Private Sub ChameleonBtn1_Click()
Unload Me
End Sub
' Ordena en forma Ascendente y descendente el LV
''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub CmdOrdenar_Click(Index As Integer)
CmdOrdenar(0).Value = False
CmdOrdenar(1).Value = False
CmdOrdenar(Index).Value = True
Call Filtrar
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyEscape Then
Unload Me
End If
End Sub
Private Sub Form_Load()
With FmPrincipal
Me.Move (.Left + .lv.Left), _
(.lv.Height + .lv.Top + .Top + 500)
End With
Call Filtrar
End Sub
Private Sub txtSearch_Change()
Call Filtrar
End Sub
Private Sub Combo1_Click()
Call Filtrar
End Sub
Private Sub Combo2_Click()
Call Filtrar
End Sub
Public Sub Filtrar()
Dim Campo, OrderByCampo, Orden As String
Dim SQL As String
If Combo1.ListIndex = -1 Then
Combo1.ListIndex = 0
End If
If Combo2.ListIndex = -1 Then
Combo2.ListIndex = 0
End If
If Combo1.ListIndex = 0 Then
Campo = "Código"
ElseIf Combo1.ListIndex = 1 Then
Campo = "Nombre"
ElseIf Combo1.ListIndex = 2 Then
Campo = "Apellidos"
End If
If Combo1.ListIndex = 3 Then
Campo = "Teléfono 1"
End If
Select Case Combo2.ListIndex
Case 0: OrderByCampo = "Código"
Case 1: OrderByCampo = "Nombre"
Case 2: OrderByCampo = "Apellidos"
Case 3: OrderByCampo = "Localidad"
End Select
If CmdOrdenar(0).Value Then Orden = "asc"
If CmdOrdenar(1).Value Then Orden = "desc"
' si el recorset está abierto lo cierra
If rs.State = adStateOpen Then
rs.Close
End If
SQL = "SELECT * FROM Clientes Where " & _
Campo & " like '" & txtSearch & _
"%' order by " & OrderByCampo & " " & Orden
rs.Open , cnn, adOpenStatic, adLockOptimistic
Call CargarListView(FmPrincipal.lv, rs)
End Sub
Modulo:
Código:
Option Explicit
Public Declare Sub InitCommonControls Lib "comctl32" ()
' variables para la conexión y el recordset
''''''''''''''''''''''''''''''''''''''''''''
Public cnn As New ADODB.Connection
Public rs As New ADODB.Recordset
Public ObjItem As ListItem
Sub Main()
On Error Resume Next
Call InitCommonControls
Err.Clear
FmPrincipal.Show
End Sub
' abre
Public Sub IniciarConexion()
With cnn
.CursorLocation = adUseClient
.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _
App.Path & "\datos.mdb" & ";Persist Security Info=False"
End With
End Sub
Public Sub CargarListView(lv As ListView, rs As ADODB.Recordset)
On Error GoTo ErrorSub
Dim i As Integer
'limpia el LV
lv.ListItems.Clear
' si hay registros
If rs.RecordCount > 0 Then
' recorre el recordset
While Not rs.EOF
' añade los datos
Set ObjItem = lv.ListItems.Add(, , rs(0))
ObjItem.SubItems(1) = rs!nom
ObjItem.SubItems(2) = rs!ap
ObjItem.SubItems(3) = rs!dni
ObjItem.SubItems(4) = rs!dir
ObjItem.SubItems(5) = rs!cp
ObjItem.SubItems(6) = rs!loc
ObjItem.SubItems(7) = rs!pro
ObjItem.SubItems(8) = rs!tel1
ObjItem.SubItems(9) = rs!tel2
ObjItem.SubItems(10) = rs!mov1
ObjItem.SubItems(11) = rs!mov2
ObjItem.SubItems(12) = rs!fax
' siguiente registro
rs.MoveNext
Wend
End If
Call ForeColorColumn(&H8000&, 0, FmPrincipal.lv)
'Call ForeColorColumn(vbRed, 6, FmPrincipal.lv)
Exit Sub
ErrorSub:
If Err.Number = 94 Then Resume Next
End Sub
' cierra
Sub Desconectar()
On Local Error Resume Next
rs.Close
Set rs = Nothing
cnn.Close
Set cnn = Nothing
End Sub
Muchas gracias por todo.
Un Saludo.