Como Desmarcar selecciones de listbox

Para Dan

Yo otra vez!

¿Me apaoyas en esto?

Lo que deseo es desmarcar check de listbox con un commandbutton...

Te adjunto la macro que tengo que meacabas de ayudar y la del boton que agrege para eliminar que no funcionamuy bien...

Mi idea es agregar un boton luego que selecciono los 7 check hago click en el boton y se limpie el textbox1 y las selecciones de los check del listbox para poder elegir mas check sin que aparezca el mensaje "se alcanzo el maximo"...

Private Sub CommandButton2_Click()
   Hoja1.Range("E2:F255")=""
r=7
for i =0 to r
  lista.Selected(i)= false
next
textbox1.text=""
End Sub
Private Sub Lista_Change()
'Por.Dante Amor
    tnum = 1   'Número de textbox
    wmax = 7   'límite por textbox
    n = 0
    t = 1
    fila = Lista.List(Lista.ListIndex, 4)
    '
    For i = 1 To tnum
        Me.Controls("TextBox" & i) = ""
    Next
    '
    Cells(fila, "F") = Lista.Selected(Lista.ListIndex)
    '
    For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
        If Cells(i, "F") = True Then
            If n = wmax Then
                MsgBox "Se alcanzó el máximo"
                Lista.Selected(Lista.ListIndex) = False
                Cells(fila, "F") = Lista.Selected(Lista.ListIndex)
                Exit Sub
            End If
            '
            If Me.Controls("TextBox" & t) = "" Then
                Me.Controls("TextBox" & t) = Cells(i, "C")
            Else
                Me.Controls("TextBox" & t) = Me.Controls("TextBox" & t) & " ; " & Cells(i, "C")
            End If
            n = n + 1
        End If
    Next
End Sub
'
Private Sub TextBox5_Change()
'Por.Dante Amor
    Me.Lista.Clear
    If Trim(TextBox5.Value) = "" Then
       Lista.List() = Range("A2:E" & Range("A" & Rows.Count).End(xlUp).Row).Value
    Else
        For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
           cadena = UCase(Cells(i, 1).Value) & UCase(Cells(i, 2).Value) & UCase(Cells(i, 3).Value)
           If cadena Like "*" & UCase(TextBox5.Value) & "*" Then
              Lista.AddItem Cells(i, "A")
              Lista.List(Lista.ListCount - 1, 1) = Cells(i, "B")
              Lista.List(Lista.ListCount - 1, 2) = Cells(i, "C")
              Lista.List(Lista.ListCount - 1, 3) = Cells(i, "D")
              Lista.List(Lista.ListCount - 1, 4) = Cells(i, "E")
           End If
        Next i
    End If
    '
    For i = 0 To Lista.ListCount - 1
        fila = Lista.List(i, 4)
        Lista.Selected(i) = Cells(fila, "F")
    Next
    Exit Sub
Errores:
   MsgBox "No se encuentra.", vbExclamation, "EXCELeINFO"
End Sub
'
Private Sub UserForm_Initialize()
'Por.Dante Amor
    With Lista
        .ColumnCount = 5
        .ColumnWidths = "60 pt;160 pt; 70 pt;0;0"
    End With
    Columns("E:F").ClearContents
    u = Range("A" & Rows.Count).End(xlUp).Row
    [E1] = 1
    [E2] = 2
    If u > 2 Then
        Range("E1:E2").AutoFill Destination:=Range("E1:E" & u), Type:=xlFillDefault
    End If
    Lista.List() = Range("A2:E" & Range("A" & Rows.Count).End(xlUp).Row).Value
End Sub
'
Private Sub CommandButton1_Click()
    Application.Visible = True
End Sub

1 respuesta

Respuesta
1

Agregué una rutina para numerar.

Te anexo el código completo:

Private Sub CommandButton2_Click()
'Por.Dante Amor
    numerar
    TextBox1 = ""
    TextBox5 = ""
End Sub
Private Sub Lista_Change()
'Por.Dante Amor
    tnum = 1   'Número de textbox
    wmax = 7   'límite por textbox
    n = 0
    t = 1
    fila = Lista.List(Lista.ListIndex, 4)
    '
    For i = 1 To tnum
        Me.Controls("TextBox" & i) = ""
    Next
    '
    Cells(fila, "F") = Lista.Selected(Lista.ListIndex)
    '
    For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
        If Cells(i, "F") = True Then
            If n = wmax Then
                MsgBox "Se alcanzó el máximo"
                Lista.Selected(Lista.ListIndex) = False
                Cells(fila, "F") = Lista.Selected(Lista.ListIndex)
                Exit Sub
            End If
            '
            If Me.Controls("TextBox" & t) = "" Then
                Me.Controls("TextBox" & t) = Cells(i, "C")
            Else
                Me.Controls("TextBox" & t) = Me.Controls("TextBox" & t) & " ; " & Cells(i, "C")
            End If
            n = n + 1
        End If
    Next
End Sub
'
Private Sub TextBox5_Change()
'Por.Dante Amor
    Me.Lista.Clear
    If Trim(TextBox5.Value) = "" Then
       Lista.List() = Range("A2:E" & Range("A" & Rows.Count).End(xlUp).Row).Value
    Else
        For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
           cadena = UCase(Cells(i, 1).Value) & UCase(Cells(i, 2).Value) & UCase(Cells(i, 3).Value)
           If cadena Like "*" & UCase(TextBox5.Value) & "*" Then
              Lista.AddItem Cells(i, "A")
              Lista.List(Lista.ListCount - 1, 1) = Cells(i, "B")
              Lista.List(Lista.ListCount - 1, 2) = Cells(i, "C")
              Lista.List(Lista.ListCount - 1, 3) = Cells(i, "D")
              Lista.List(Lista.ListCount - 1, 4) = Cells(i, "E")
           End If
        Next i
    End If
    '
    For i = 0 To Lista.ListCount - 1
        fila = Lista.List(i, 4)
        Lista.Selected(i) = Cells(fila, "F")
    Next
    Exit Sub
Errores:
   MsgBox "No se encuentra.", vbExclamation, "EXCELeINFO"
End Sub
'
Private Sub UserForm_Activate()
'Por.Dante Amor
    With Lista
        .ColumnCount = 5
        .ColumnWidths = "60 pt;160 pt; 70 pt;0;0"
    End With
    numerar
End Sub
'
Sub numerar()
'Por.Dante Amor
    Columns("E:F").Clear
    u = Range("A" & Rows.Count).End(xlUp).Row
    [E1] = 1
    [E2] = 2
    If u > 2 Then
        Range("E1:E2").AutoFill Destination:=Range("E1:E" & u), Type:=xlFillDefault
    End If
    Lista.List() = Range("A2:E" & Range("A" & Rows.Count).End(xlUp).Row).Value
End Sub
Private Sub CommandButton1_Click()
    Application.Visible = True
End Sub
'
Private Sub UserForm_Terminate()
    Columns("E:F").Clear
End Sub

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas