Problemas al seleccionar un dato de una listbox y modificarlo
Selecciono un dato que se encuentra en una listbox y lo modifico, no lo modifica si no que se agrega dos veces y borra el dato que sigue abajo de el.. Pero esto no ocurre con todos los datos ya que hay algunos que los modifica sin problema.
Dim i As Integer
If ListBox1.Text = "" Then
MsgBox "Nombre inválido", vbInformation + vbOKOnly
ListBox1.SetFocus
Exit Sub
End If
If Not (Mid(ListBox1.Text, 1, 1) Like "[a-z]" Or Mid(ListBox1.Text, 1, 1) Like "[A-Z]") Then
MsgBox "Nombre inválido", vbInformation + vbOKOnly
ListBox1.SetFocus
Exit Sub
End If
For i = 2 To Len(ListBox1.Text)
If Mid(ListBox1.Text, i, 1) Like "#" Then
MsgBox "Nombre inválido", vbInformation + vbOKOnly
ListBox1.SetFocus
Exit Sub
End If
Next
Sheets("Usuarios").Activate
Dim fCliente As Integer
fCliente = nCliente(ListBox1.Text)
If fCliente = 0 Then
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Activate ' si el registro no existe, se va al final.
Loop
Else
Cells(fCliente, 1).Select ' cuando ya existe el registro, cumple esta condición.
End If
'Aqui es cuando agregamos o modificamos el registro
Application.ScreenUpdating = False
ActiveCell = ListBox1
ActiveCell.Offset(0, 0) = TextBox1
ActiveCell.Offset(0, 1) = TextBox2
ActiveCell.Offset(0, 2) = TextBox3
ActiveCell.Offset(0, 3) = TextBox4
ActiveCell.Offset(0, 4) = TextBox5
ActiveCell.Offset(0, 5) = TextBox6
ActiveCell.Offset(0, 6) = TextBox7
ActiveCell.Offset(0, 7) = TextBox8
ActiveCell.Offset(0, 8) = TextBox9
ActiveCell.Offset(0, 9) = TextBox10
ActiveCell.Offset(0, 10) = TextBox11
ActiveCell.Offset(0, 11) = TextBox12
ActiveCell.Offset(0, 12) = TextBox13
ActiveCell.Offset(0, 13) = TextBox14
Application.ScreenUpdating = True
Esto es lo que tengo en el boton de modificar, podrían corregirme el error por favor .
ListBox1. SetFocus
End Sub
1 respuesta
Te anexo las macros de actualizar y eliminar
Private Sub btn_buscar_Click()
'Act.Por.Dante Amor
Me.ListBox1.Clear
If Me.txt_buscar.Value = Empty Then
MsgBox "Escriba un registro para buscar"
Me.txt_buscar.SetFocus
Exit Sub
End If
'
items = Hoja1.Range("tabla1").CurrentRegion.Rows.Count
For i = 2 To items
dato = ""
For k = 1 To 10
dato = dato & LCase(Cells(i, k).Value)
Next
If dato Like "*" & LCase(Me.txt_buscar.Value) & "*" Then
Me.ListBox1.AddItem Cells(i, 1)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = Cells(i, 2)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 2) = Cells(i, 3)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 3) = Cells(i, 4)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 4) = Cells(i, 5)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 5) = Cells(i, 6)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 6) = Cells(i, 7)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 7) = Cells(i, 8)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 8) = Cells(i, 9)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 9) = i 'número de fila
End If
Next i
Me.txt_buscar.SetFocus
Me.txt_buscar.SelStart = 0
Me.txt_buscar.SelLength = Len(Me.txt_buscar.Text)
End Sub
'
Private Sub ListBox1_Click()
'Por.Dante Amor
fila = Val(ListBox1.List(ListBox1.ListIndex, 9))
For i = 1 To 14
Me.Controls("TextBox" & i) = Hoja1.Cells(fila, i)
Next
End Sub
'
Private Sub btn_eliminar_Click()
'Por.Dante Amor
If ListBox1.ListIndex = -1 Then
MsgBox "Selecciona un registro del listbox", vbInformation + vbOKOnly
ListBox1.SetFocus
Exit Sub
End If
'
fila = Val(ListBox1.List(ListBox1.ListIndex, 9))
res = MsgBox("Eliminar registro", vbYesNo, "ELIMINAR")
If res = vbYes Then
Hoja1.Rows(fila).Delete
txt_buscar = ""
MsgBox "Registro eliminado", vbInformation, "ELIMINAR"
End If
End Sub
'
Private Sub btn_Finalizar_Click()
End
End Sub
'
Private Sub btn_Registrar_Click()
ActiveSheet.Cells(2, 1).Select
Selection.EntireRow.Insert
ActiveSheet.Cells(2, 1) = TextBox1
ActiveSheet.Cells(2, 2) = TextBox2
ActiveSheet.Cells(2, 3) = TextBox3
ActiveSheet.Cells(2, 4) = TextBox4
ActiveSheet.Cells(2, 5) = TextBox5
ActiveSheet.Cells(2, 6) = TextBox6
ActiveSheet.Cells(2, 7) = TextBox7
ActiveSheet.Cells(2, 8) = TextBox8
ActiveSheet.Cells(2, 9) = TextBox9
ActiveSheet.Cells(2, 10) = TextBox10
ActiveSheet.Cells(2, 11) = TextBox11
ActiveSheet.Cells(2, 12) = TextBox12
ActiveSheet.Cells(2, 13) = TextBox13
ActiveSheet.Cells(2, 14) = TextBox14
TextBox1 = Empty
TextBox2 = Empty
TextBox3 = Empty
TextBox4 = Empty
TextBox5 = Empty
TextBox6 = Empty
TextBox7 = Empty
TextBox8 = Empty
TextBox9 = Empty
TextBox10 = Empty
TextBox11 = Empty
TextBox12 = Empty
TextBox13 = Empty
TextBox14 = Empty
TextBox1.SetFocus
Ordenar
End Sub
Private Sub cmd_Modificar_Click()
'Por.Dante Amor
If ListBox1.ListIndex = -1 Then
MsgBox "Selecciona un registro del listbox", vbInformation + vbOKOnly
ListBox1.SetFocus
Exit Sub
End If
If TextBox1.Value = "" Then
MsgBox "Captura un Depto", vbInformation, "MODIFICAR"
TextBox1.SetFocus
Exit Sub
End If
'Agregar otros texbox si quieres validarlos
'
fila = Val(ListBox1.List(ListBox1.ListIndex, 9))
For i = 1 To 14
Hoja1.Cells(fila, i) = Me.Controls("TextBox" & i)
Next
MsgBox "Registro actualizado", vbInformation, "MODIFICAR"
End Sub
Private Sub txt_buscar_Change()
'Por.Dante Amor
If tst_buscar = "" Then
For i = 1 To 14
Me.Controls("TextBox" & i) = Empty
Next
ListBox1.Clear
End If
End Sub
'
Private Sub UserForm_Initialize()
'Le digo cuántas columnas
ListBox1.ColumnCount = 9
'Asigno el ancho a cada columna
Me.ListBox1.ColumnWidths = "100 pt;100 pt;100 pt;100 pt;100 pt;100 pt;100 pt;100 pt;100 pt;100 pt"
'El origen de los datos es la Tabla1
' ListBox1.RowSource = "Tabla1"
End Sub'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
