Notifications
Clear all

Selecionar CheckBox para ListView

4 Posts
3 Usuários
2 Reactions
1,456 Visualizações
(@dunguinha)
Posts: 61
Trusted Member
Topic starter
 

Olá à todos.

No projeto tenho duas CheckBox "Só Aprovado" e "Só Avaliação". Preciso listar no ListView só os aprovados quando ticado essa CheckBox.

Também listar no ListView só avaliação quando ticado essa CheckBox.

Sem as checkBox ticadas listar as duas.

Agradeço quem puder ajudar com essa adaptação.

 
Postado : 25/09/2020 10:23 pm
(@laerteb)
Posts: 67
Trusted Member
 

Bom dia, @dunguinha

Se entendi o que solicitou, então os códigos a seguir funcionarão como esperado

por ti...

Terás que copiar estes códigos abaixo (referente aos CheckBox) no seu userform:

Private Sub CheckBox1_Click()

Dim linha As Integer
Dim xcol As Integer
Dim xcelu As String

If UserFormShow.CheckBox1.Value = True Then
UserFormShow.CheckBox2.Value = False
End If

xcol = 6
linha = 2
ListView1.ListItems.Clear

BaseDados.Select
With BaseDados

While .Cells(linha, 1).Value <> Empty
xcelu = .Cells(linha, xcol).Value

If xcelu = "Aprovado" Then

Set li = ListView1.ListItems.Add(Text:=BaseDados.Cells(linha, 1).Value) 'ID
li.ListSubItems.Add Text:=BaseDados.Cells(linha, 2).Value 'Data
li.ListSubItems.Add Text:=BaseDados.Cells(linha, 3).Value 'Nome
li.ListSubItems.Add Text:=BaseDados.Cells(linha, 4).Value 'Cidade
li.ListSubItems.Add Text:=BaseDados.Cells(linha, 5).Value 'Estado
li.ListSubItems.Add Text:=BaseDados.Cells(linha, 6).Value 'Status

End If
linha = linha + 1

Wend
End With

If UserFormShow.CheckBox1.Value = False _
And UserFormShow.CheckBox2.Value = False Then
Call preenchelistview
End If

Me.Label6.Caption = " Registros Localizados: " & Format(ListView1.ListItems.Count, "00")

End Sub

Private Sub CheckBox2_Click()

Dim linha As Integer
Dim xcol As Integer
Dim xcelu As String

If UserFormShow.CheckBox2.Value = True Then
UserFormShow.CheckBox1.Value = False
End If

xcol = 6
linha = 2
ListView1.ListItems.Clear

BaseDados.Select
With BaseDados

While .Cells(linha, 1).Value <> Empty
xcelu = .Cells(linha, xcol).Value

If xcelu = "Avaliação" Then

Set li = ListView1.ListItems.Add(Text:=BaseDados.Cells(linha, 1).Value) 'ID
li.ListSubItems.Add Text:=BaseDados.Cells(linha, 2).Value 'Data
li.ListSubItems.Add Text:=BaseDados.Cells(linha, 3).Value 'Nome
li.ListSubItems.Add Text:=BaseDados.Cells(linha, 4).Value 'Cidade
li.ListSubItems.Add Text:=BaseDados.Cells(linha, 5).Value 'Estado
li.ListSubItems.Add Text:=BaseDados.Cells(linha, 6).Value 'Status

End If
linha = linha + 1

Wend
End With

If UserFormShow.CheckBox1.Value = False _
And UserFormShow.CheckBox2.Value = False Then
Call preenchelistview
End If

Me.Label6.Caption = " Registros Localizados: " & Format(ListView1.ListItems.Count, "00")

End Sub

Private Sub preenchelistview()

ListView1.ListItems.Clear

lastRow = BaseDados.Cells(BaseDados.Cells.Rows.Count, colID).End(xlUp).Row 'encontrar a última linha preenchida
For linha = 2 To lastRow
Set li = ListView1.ListItems.Add(Text:=Format(BaseDados.Cells(linha, colID).Value, "00"))
li.ListSubItems.Add Text:=BaseDados.Cells(linha, colData).Value
li.ListSubItems.Add Text:=BaseDados.Cells(linha, colNome).Value
li.ListSubItems.Add Text:=BaseDados.Cells(linha, colCidade).Value
li.ListSubItems.Add Text:=BaseDados.Cells(linha, colEstado).Value
li.ListSubItems.Add Text:=BaseDados.Cells(linha, colStatusContrato).Value
Next linha


Dim Colunas As Integer
Dim Linhas As Integer
Dim contador As Integer
Dim UserForm1
Dim x, i

On Error Resume Next

With UserForm1

Colunas = ListView1.ColumnHeaders.Count
Linhas = ListView1.ListItems.Count

For i = 1 To Linhas

If ListView1.ListItems(i).ListSubItems(5) = "Avaliação" Then
ListView1.ListItems(i).ForeColor = RGB(199, 0, 0)


For x = 1 To Colunas - 1
ListView1.ListItems(i).ListSubItems(x).ForeColor = RGB(199, 0, 0)

Next
End If
Next
End With

Me.Label6.Caption = " Registros Localizados: " & Format(ListView1.ListItems.Count, "00")

End Sub

Verifique e teste...

Qualquer coisa estamos aqui para ajudá-lo 😉 

 

Aguardando sua resposta e seu Feed Back ... se foi útil, não esqueça de Clicar no Botão "Curtir"...

 

LaerteB 🙂

 
Postado : 26/09/2020 8:04 am
Dunguinha reacted
(@anderson)
Posts: 203
Reputable Member
 

Anexo

Em 90% dos casos em que não se anexa o arquivo, ocorrem mal-entendidos, gerando perda de tempo de ambos os lados.

 
Postado : 26/09/2020 8:16 am
Dunguinha reacted
(@dunguinha)
Posts: 61
Trusted Member
Topic starter
 

Bom dia Feras, Laerte e Anderson.

Maravilha o código que disponibilizaram, era mais do que eu precisava.

Muito obrigado pelo esforço de vocês.

 
Postado : 26/09/2020 8:46 am