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

1 Respuesta

Respuesta
1

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
' : )

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas