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 SubPrivate 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 de Dante Amor
1