Este es el formulario principal:
Código:
Siempre me salta este error al eliminar -2747217904Option 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
El formulario de buscar y ordenar:
Código:
Modulo: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
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.