Como puedo activar una celda desde un ListBox, para que agregue una fecha en la fila activa.
Tengo un listbox es cual me muestra el resultado de dos filtros mediante comboBox, lo que requiero hacer y no he podido es que al seleccionar en el listbox una fila, ésta se active para poder colocar una fecha mediante un DTPicker en el mismo formulario y que esta fecha se coloque automáticamente en el Excel.
Private Sub ComboBox1_Change()
Dim fila As Integer
Dim uf As Integer
Dim d1, d2 As String
fila = 2
uf = Sheets("CONSUMO").Range("A" & Rows.Count).End(xlUp).Row
ComboBox2.Clear
While Sheets("CONSUMO").Cells(fila, 1) <> Empty
d1 = ComboBox1
d2 = Sheets("CONSUMO").Cells(fila, 1)
If d1 = d2 Then
ComboBox2.AddItem Sheets("CONSUMO").Cells(fila, 4)
End If
fila = fila + 1
Wend
End Sub
Private Sub ComboBox2_Change()
Dim i As Byte, tot As Double, tot1 As Double
'Evito movimientos de la pantalla
Application.ScreenUpdating = False
Dim fila, a As Integer
On Error Resume Next
'Borra datos del listbox
ListBox1.Clear
ListBox1.ColumnCount = 6
a = 0
fila = 2
'Bucle mientras la fila no esté vacia
While Sheets("CONSUMO").Cells(fila, 4) <> Empty
dato = ComboBox2
'Si el dato de la fila coincide con textbox carga los datos al listbox
var = Sheets("CONSUMO").Cells(fila, 4)
If ComboBox2 = "" Then
If ComboBox1 = "" Then
Else
If Sheets("CONSUMO").Cells(fila, 1) = ComboBox1 Then
filtrar (fila)
End If
End If
Else
If Sheets("CONSUMO").Cells(fila, 4) = ComboBox2 Then
If ComboBox1 = "" Then
filtrar (fila)
Else
If Sheets("CONSUMO").Cells(fila, 1) = ComboBox1 Then
filtrar (fila)
End If
End If
End If
End If
'Aumento la fila para que pase a la siguiente
fila = fila + 1
Wend
'Devuelvo movimientos de la pantalla
Application.ScreenUpdating = True
End Sub
Sub filtrar(fila)
'Copia los datos de la celda list box
a = ListBox1. ListCount
ListBox1. AddItem
ListBox1.List(a, 0) = Sheets("CONSUMO"). Cells(fila, 1)
ListBox1.List(a, 1) = Sheets("CONSUMO"). Cells(fila, 2)
ListBox1.List(a, 2) = Sheets("CONSUMO"). Cells(fila, 3)
ListBox1.List(a, 3) = Sheets("CONSUMO"). Cells(fila, 4)
ListBox1.List(a, 4) = Sheets("CONSUMO"). Cells(fila, 5)
ListBox1.List(a, 5) = Sheets("CONSUMO"). Cells(fila, 6)
'Aumento la fila para que pase a la siguiente
fila = fila + 1
'Devuelvo movimientos de la pantalla
Application.ScreenUpdating = True
End Sub
Private Sub ComboBox3_Change()
End Sub
Private Sub CommandButton2_Click()
If DTPicker1 = Empty Then
MsgBox ("Debe cargar fecha de salida"), vbCritical, "AVISO"
DTPicker1.SetFocus
Exit Sub
End If
ActiveCell.Offset(0, 5) = DTPicker1.Value
ComboBox1. Clear
ComboBox2.Clear
ListBox1.Clear
ComboBox1.SetFocus
MsgBox ("El registro se guardó con éxito"), vbInformation, "AVISO"
Unload Me
UserForm23.Show
End Sub
Private Sub CommandButton3_Click()
Unload Me
UserForm23.Show
End Sub
Private Sub ListBox1_AfterUpdate()
Dim z As Integer
z = ListBox.ListIndex + 2
Cells(z, 5) = DTPicker1
End Sub
Private Sub ListBox1_Click()
End Sub
Private Sub UserForm_Initialize()
Dim sd As New Collection
Dim celda As Range
Dim dato
Dim r As String
Dim uf As Integer
Application.ScreenUpdating = False
On Error Resume Next
ComboBox1.Clear
Sheets("CONSUMO").Select
Range("A2").Select
uf = Range("A" & Rows.Count).End(xlUp).Row
r = "A2:A" & uf
For Each celda In Range(r)
sd.Add celda.Value, CStr(celda.Value)
Next celda
For Each dato In sd
ComboBox1.AddItem dato
Next dato
Application.ScreenUpdating = True
End Sub
H o l a:
Envíame tu archivo con tu formulario, me dices cómo trabaja tu formulario y en qué momento quieres pasar la fecha a la hoja.
Mi correo [email protected]
En el asunto del correo escribe tu nombre de usuario “Jessy Vazquez” y el título de esta pregunta.
Hola Dante! Te lo acabo de enviar.
Gracias!!!!
H o l a:
Te anexo las macros actualizadas:
Private Sub ComboBox1_Change()
Dim fila As Integer
Dim uf As Integer
Dim d1, d2 As String
fila = 2
uf = Sheets("CONSUMO").Range("A" & Rows.Count).End(xlUp).Row
ComboBox2.Clear
While Sheets("CONSUMO").Cells(fila, 1) <> Empty
d1 = ComboBox1
d2 = Sheets("CONSUMO").Cells(fila, 1)
If d1 = d2 Then
ComboBox2.AddItem Sheets("CONSUMO").Cells(fila, 4)
End If
fila = fila + 1
Wend
End Sub
'
Private Sub ComboBox2_Change()
'Act.Por.Dante Amor
ListBox1.Clear 'Borra datos del listbox
'carga listbox
Set h = Sheets("CONSUMO")
Set r = h.Columns("A")
Set b = r.Find(ComboBox1, lookat:=xlWhole)
If Not b Is Nothing Then
celda = b.Address
Do
If h.Cells(b.Row, "D") = ComboBox2 Then
ListBox1. AddItem Sheets("CONSUMO"). Cells(b.Row, "A")
ListBox1. List(ListBox1.ListCount - 1, 1) = h. Cells(b.Row, "B")
ListBox1. List(ListBox1.ListCount - 1, 2) = h. Cells(b.Row, "C")
ListBox1. List(ListBox1.ListCount - 1, 3) = h. Cells(b.Row, "D")
ListBox1. List(ListBox1.ListCount - 1, 4) = h. Cells(b.Row, "E")
ListBox1. List(ListBox1.ListCount - 1, 5) = h. Cells(b.Row, "F")
ListBox1.List(ListBox1.ListCount - 1, 6) = b.Row
End If
Set b = r.FindNext(b)
Loop While Not b Is Nothing And b.Address <> celda
End If
End Sub
'
Private Sub CommandButton2_Click()
If DTPicker1 = Empty Then
MsgBox ("Debe cargar fecha de salida"), vbCritical, "AVISO"
DTPicker1.SetFocus
Exit Sub
End If
If ListBox1.ListIndex = -1 Then
MsgBox "Selecciona un registro del listbox"
Exit Sub
End If
fila = Val(ListBox1.List(ListBox1.ListIndex, 6))
Cells(fila, "F") = DTPicker1
'ComboBox1. Clear
'ComboBox2.Clear
'ListBox1.Clear
'ComboBox1.SetFocus
MsgBox ("El registro se guardó con éxito"), vbInformation, "AVISO"
Unload Me
UserForm23.Show
End Sub
'
Private Sub UserForm_Initialize()
Dim sd As New Collection
Dim celda As Range
Dim dato
Dim r As String
Dim uf As Integer
Application.ScreenUpdating = False
On Error Resume Next
ComboBox1.Clear
Sheets("CONSUMO").Select
Range("A2").Select
uf = Range("A" & Rows.Count).End(xlUp).Row
r = "A2:A" & uf
For Each celda In Range(r)
sd.Add celda.Value, CStr(celda.Value)
Next celda
For Each dato In sd
ComboBox1.AddItem dato
Next dato
Application.ScreenUpdating = True
ListBox1.ColumnCount = 6
End Sub' : ) 'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias ' : )
