Para Dante - Modificar y eliminar datos en un listbox filtrado
Estimado Dante
Necesito modificar un registro tomado del listbox con la información filtrada y que esto también afecte a la hoja de excel, también requiero borrar un registro tomado del listbox con la información filtrada y que esto también afecte a la hoja de excel.
Gracias.
1 Respuesta
Te anexo todas las macros, ya que la mayoría sufrió cambios. Estoy utilizando la columna "S" para poner la numeración de la fila, si agregas columnas, se deberá modificar la macro.
Private Sub Actualizar_Click()
If ListBox1.ListIndex = -1 Then Exit Sub
f = ListBox1.List(ListBox1.ListIndex, 18)
r = ListBox1.ListIndex
Sheets("LVT").Range("A" & f) = (TextBox2)
Sheets("LVT").Range("B" & f) = Format(TextBox3, "mm/dd/yyyy")
For i = 4 To 12
Sheets("LVT").Cells(f, i - 1) = Controls("TextBox" & i)
Next
Call filtrar
ListBox1.ListIndex = r
End Sub
Private Sub ComboBox1_Change()
'Por.Dante Amor
filtrar
End Sub
Private Sub ComboBox2_Change()
'Por.Dante Amor
filtrar
End Sub
Private Sub ComboBox2_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
KeyAscii = 0
End Sub
Private Sub Eliminar_Click()
'Por.Dante Amor
If ListBox1.ListIndex = -1 Then Exit Sub
Pregunta = MsgBox("Está seguro de eliminar el registro?", vbYesNo + vbQuestion, "EXCELeINFO")
If Pregunta = vbYes Then
f = ListBox1.List(ListBox1.ListIndex, 18)
Rows(f).Delete
Call filtrar
End If
If ListBox1.ListCount > 0 Then
ListBox1.ListIndex = 0
End If
End Sub
Private Sub ListBox1_Click()
'Por.Dante Amor
TextBox2.Text = (ListBox1.Column(0))
TextBox3.Text = CDate(ListBox1.Column(1))
For i = 4 To 12
Controls("TextBox" & i) = ListBox1.Column(i - 2)
Next
TextBox2.SetFocus
TextBox2.SelStart = 0
TextBox2.SelLength = Len(TextBox2)
End Sub
Sub filtrar()
'Por.Dante Amor
Set h1 = Sheets("LVT")
Set h2 = Sheets("tmp")
Set h3 = Sheets("PERIODOS")
'Application.ScreenUpdating = False
'
If h1.FilterMode Then h1.ShowAllData
h2.Range("A:S").Clear
per = ""
suc = IIf(ComboBox1 = "", "", Val(ComboBox1))
If ComboBox2 <> "" And ComboBox2.ListIndex > -1 Then
per = h3.Cells(ComboBox2.ListIndex + 1, "A")
End If
h2.Range("Y2") = suc
h2.Range("Z2") = per
'
u = h1.Range("A" & Rows.Count).End(xlUp).Row
h1.[S1] = "num"
h1.[S2] = 2
h1.[S3] = 3
If u > 2 Then
h1.Range("S2:S3").AutoFill h1.Range("S2:S" & u)
End If
'
h1.Range("A1:S" & u).AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=h2.Range("Y1:Z2"), _
CopyToRange:=h2.Range("A1"), Unique:=False
'
ListBox1.ColumnCount = 19
ListBox1.ColumnHeads = False
ListBox1.ColumnWidths = "60;60;60;60;60;60;60;60;60;60;60;0;0;0;0;0;0;0;0"
If h2.Range("A2") <> "" Then
ListBox1.RowSource = "tmp!A2:S" & Sheets("tmp").Range("A" & Rows.Count).End(xlUp).Row
Else
ListBox1.RowSource = ""
End If
h1.Range("S:S").ClearContents
End SubVa también la versión 2 del archivo.
https://www.dropbox.com/s/g7ln3j73dy2bub1/prueba%20DAM2.xlsm?dl=0
Saludos. Dante Amor
No olvides valorar la respuesta.
Error 1004
Error en el método autofill de la clase range
Hice varias pruebas. Primero modifique una registro y al tratar de eliminar otro registro se detiene la macro. También trate de eliminar directamente el registro sin ninguna acción anterior pero el código se detiene.
Este es el código y se detiene don de esta la letra negrita
Sub filtrar()
'Por.Dante Amor
Set h1 = Sheets("LVT")
Set h2 = Sheets("tmp")
Set h3 = Sheets("PERIODOS")
'Application.ScreenUpdating = False
'
If h1.FilterMode Then h1.ShowAllData
h2.Range("A:S").Clear
per = ""
suc = IIf(ComboBox1 = "", "", Val(ComboBox1))
If ComboBox2 <> "" And ComboBox2.ListIndex > -1 Then
per = h3.Cells(ComboBox2.ListIndex + 1, "A")
End If
h2.Range("Y2") = suc
h2.Range("Z2") = per
'
u = h1.Range("A" & Rows.Count).End(xlUp).Row
h1.[S1] = "num"
h1.[S2] = 2
h1.[S3] = 3
If u > 2 Then
h1.Range("S2:S3").AutoFill h1.Range("S2:S" & u)
End If
'
h1.Range("A1:S" & u).AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=h2.Range("Y1:Z2"), _
CopyToRange:=h2.Range("A1"), Unique:=False
'
ListBox1.ColumnCount = 19
ListBox1.ColumnHeads = False
ListBox1.ColumnWidths = "60;60;60;60;60;60;60;60;60;60;60;0;0;0;0;0;0;0;0"
If h2.Range("A2") <> "" Then
ListBox1.RowSource = "tmp!A2:S" & Sheets("tmp").Range("A" & Rows.Count).End(xlUp).Row
Else
ListBox1.RowSource = ""
End If
h1.Range("S:S").ClearContents
End Sub
Estimado dante:
Lamento molestarte nuevamente.
Hice la corrección que me diste, funciona de maravilla, cuando volví a abrir el formulario ya no funcionaba.
https://mega.co.nz/#!JdxF1TzZ!SwtrEcyX7cB7aq3oInt39CkvCBO_2d6FW3A3zRhYA0I
Te envío el archivo
¿Y ahora qué no funciona?
¿Qué error te envía?
¿En qué línea se detiene?
¿Y explícame qué pasos estabas haciendo?
Prueba con el siguiente archivo, realicé varias pruebas y no me envió error. Pero le corregí un pequeño detalle.
https://www.dropbox.com/s/uepwkkc8o0i6rij/prueba%20DAM3.xlsm?dl=0
En el nuevo archivo que me enviaste se lanza el siguiente error 1004
Error en el el método clear de la clase range.
Primero modifique una registro y al tratar de eliminar otro registro se detiene la macro. También trate de eliminar directamente el registro sin ninguna acción anterior pero el código se detiene.
Se detiene en la línea negrita
Sub filtrar()
'Por.Dante Amor
Set h1 = Sheets("LVT")
Set h2 = Sheets("tmp")
Set h3 = Sheets("PERIODOS")
'Application.ScreenUpdating = False
'
If h1.FilterMode Then h1.ShowAllData
h2.Range("A:S").Clear
per = ""
suc = IIf(ComboBox1 = "", "", Val(ComboBox1))
If ComboBox2 <> "" And ComboBox2.ListIndex > -1 Then
per = h3.Cells(ComboBox2.ListIndex + 1, "A")
End If
h2.Range("Y2") = suc
h2.Range("Z2") = per
'
u = h1.Range("A" & Rows.Count).End(xlUp).Row
h1.[S1] = "num"
h1.[S2] = 2
If u > 2 Then h1.[S3] = 3
If u > 3 Then h1.Range("S2:S3").AutoFill h1.Range("S2:S" & u)
'
h1.Range("A1:S" & u).AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=h2.Range("Y1:Z2"), _
CopyToRange:=h2.Range("A1"), Unique:=False
'
ListBox1.ColumnCount = 19
ListBox1.ColumnHeads = False
ListBox1.ColumnWidths = "60;60;60;60;60;60;60;60;60;60;60;0;0;0;0;0;0;0;0"
If h2.Range("A2") <> "" Then
ListBox1.RowSource = "tmp!A2:S" & Sheets("tmp").Range("A" & Rows.Count).End(xlUp).Row
Else
ListBox1.RowSource = ""
End If
h1.Range("S:S").ClearContents
End Sub
Gracias
- Compartir respuesta
