Filtro de pesquisa em Banco de Dados externo com checkbox

[HAPedroso]

Bom dia pessoal,

Preciso de uma ajuda de vocês, estou desenvolvendo um projeto em que trabalho com uma planilha do excel como banco de dados externa aos useforms. Consegui pegar alguns arquivos aqui no forum, juntá-los e adaptá-los a minha necessidade, porém agora me ocorreu um impasse, quando um form é carregado, uma listview recebe os dados do banco de dados, e existem algumas textbox para realizar o filtro de pesquisa, porém eu inseri um checkbox no cadastro (cliente ativo/inativo), que é carregada normalmente para o banco de dados, porém não sei como fazer a conexão com o banco de dados e os argumentos específicos no script para acrescentar o filtro com uma duas checkbox. O que preciso é que ao marcar a checkbox "ativo" ele me traga na listview somente os clientes ativos, se eu marcar a checkbox "inativo", só me traga os inativos, e se eu marcar as duas ("ativo" e "inativo"), me traga todos os clientes.

Segue o código sem a conexão com a checkbox:

Private Sub UserForm_Initialize()



lstLista.ColumnHeaders.Clear 'Clear the Column Headers
lstLista.ListItems.Clear
With lstLista
.Gridlines = True
'.FullRowSelect
.View = lvwReport
'.ColumnHeaders.Add Text:="Nome/Razão Social", Width:=200
'.ColumnHeaders.Add Text:="CPF/CNPJ", Width:=85
End With

'preenche o cboDirecao e seleciona o primeiro item
cboDirecao.Clear
cboDirecao.AddItem "Ascendente"
cboDirecao.AddItem "Descendente"
cboDirecao.ListIndex = 0

Call DefinePlanilhaDados1
Call DefinePlanilhaDados

Call PopulaCidades
Call PopulaListBox(vbNullString, vbNullString)
', vbNullString, vbNullString, vbNullString, vbNullString
Call HabilitaBotoesAlteracao
Call CarregaDadosInicial
Call DesabilitaControles
txtNomeCliente1.SetFocus

End Sub
________________________________________________________

Private Sub DefinePlanilhaDados()
Dim abrirArquivo As Boolean
Dim wb As Workbook
Dim caminhoCompleto As String
Dim ARQUIVO_DADOS As String
Dim PASTA_DADOS As String

abrirArquivo = True

ARQUIVO_DADOS = Range("ARQUIVO_DADOS").Value
PASTA_DADOS = Range("PASTA_DADOS").Value

If ThisWorkbook.Name <> ARQUIVO_DADOS Then
'monta a string do caminho completo
If PASTA_DADOS = vbNullString Or PASTA_DADOS = "" Then
caminhoCompleto = Replace(ThisWorkbook.FullName, ThisWorkbook.Name, vbNullString) & ARQUIVO_DADOS
Else
If Right(PASTA_DADOS, 1) = "\" Then
caminhoCompleto = PASTA_DADOS & ARQUIVO_DADOS
Else
caminhoCompleto = PASTA_DADOS & "\" & ARQUIVO_DADOS
End If
End If

'verifica se o arquivo não está aberto
For Each wb In Application.Workbooks
If wb.Name = ARQUIVO_DADOS Then
abrirArquivo = False
Exit For
End If
Next

'atribui o arquivo
If abrirArquivo Then
Set wbCadastro = Workbooks.Open(Filename:=caminhoCompleto, ReadOnly:=True)
Else
Set wbCadastro = Workbooks(ARQUIVO_DADOS)
End If
Else
Set wbCadastro = ThisWorkbook
End If

Set wsCadastro = wbCadastro.Worksheets(nomePlanilhaCadastro)

'oculta o arquivo de dados
wbCadastro.Windows(1).Visible = False

End Sub
_____________________________________
Private Sub DefinePlanilhaDados1()
Dim wb As Workbook
Dim caminhoCompleto As String
Dim ARQUIVO_DADOS As String
Dim PASTA_DADOS As String

ThisWorkbook.Activate

ARQUIVO_DADOS = Range("ARQUIVO_DADOS").Value
PASTA_DADOS = Range("PASTA_DADOS").Value

If ThisWorkbook.Name <> ARQUIVO_DADOS Then
'monta a string do caminho completo
If PASTA_DADOS = vbNullString Or PASTA_DADOS = "" Then
caminhoCompleto = Replace(ThisWorkbook.FullName, ThisWorkbook.Name, vbNullString) & ARQUIVO_DADOS
Else
If Right(PASTA_DADOS, 1) = "\" Then
caminhoCompleto = PASTA_DADOS & ARQUIVO_DADOS
Else
caminhoCompleto = PASTA_DADOS & "\" & ARQUIVO_DADOS
End If
End If
End If

caminhoArquivoDados = caminhoCompleto

End Sub
___________________________________________

Private Sub PopulaCidades()

lstCidades.Clear 'Clear the Column Headers


Dim conn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim sql As String

Set conn = New ADODB.Connection
With conn
' .Provider = "Microsoft.JET.OLEDB.4.0" 'Excel 2003
.Provider = "Microsoft.ACE.OLEDB.12.0" 'Excel 2007

.ConnectionString = "Data Source=" & caminhoArquivoDados & ";Extended Properties=Excel 8.0;"
.Open
End With

sql = "SELECT DISTINCT Cidade_CLIENTE FROM [Cliente$]"

Set rst = New ADODB.Recordset
With rst
.ActiveConnection = conn
.Open sql, conn, adOpenDynamic, _
adLockBatchOptimistic
End With

Do While Not rst.EOF
If Not IsNull(rst(0).Value) Then
lstCidades.AddItem rst(0).Value
End If
rst.MoveNext
Loop

' Fecha o conjunto de registros.
Set rst = Nothing
' Fecha a conexão.
conn.Close

End Sub
____________________________________________________

Private Sub PopulaListBox(ByVal NomeEmpresa As String, ByVal cpfcnpj As String)
', ByVal NomeContato As String, ByVal Endereco As String, ByVal Telefone As String, ByVal Regiao As String
On Error GoTo TrataErro

Dim rst As ADODB.Recordset
Dim campo As Field
Dim myArray() As Variant
Dim i As Integer
Dim li As ListItem, fld As Field, ch As ColumnHeader

Dim Column As Long
Dim Counter As Long
Counter = 0

Set rst = PreecheRecordSet(NomeEmpresa, cpfcnpj)
', NomeContato, Endereco, Telefone, Regiao
'preenche o combobox com os nomes dos campos
'persiste o índice
Dim indiceTemp As Long
indiceTemp = cboOrdenarPor.ListIndex
cboOrdenarPor.Clear
For Each campo In rst.Fields
cboOrdenarPor.AddItem campo.Name
Next
'recupera o índice selecionado
cboOrdenarPor.ListIndex = indiceTemp

'Colunas a Preencher Inicia na Primeira
For i = 0 To rst.Fields.Count - 1 'For i = 1 : a partir da 2ª coluna
Set ch = lstLista.ColumnHeaders.Add(, , rst.Fields(i).Name)
'ch.Width = 48 'Define o Tamanho de Todas as COLUNAS
'MsgBox rst.Fields(i).Name
Next

'Clear the Column Headers
lstLista.ListItems.Clear

'coloca as linhas do RecordSet num Array, se houver linhas neste
If Not rst.BOF Then
Do While Not rst.EOF

'Preenche o LISTVIEW a partir da 2ª Coluna
'Set li = lstLista.ListItems.Add(, "k" & rst.Fields(0), CheckNull(rst.Fields(1)))
'Fill in the rest of the columns
'For i = 2 To rst.Fields.Count - 1
'li.SubItems(i - 1) = CheckNull(rst.Fields(i))

'Preenche o LISTVIEW a partir da 1ª Coluna
Set li = lstLista.ListItems.Add(, "k" & rst.Fields(0), CheckNull(rst.Fields(0)))
'Fill in the rest of the columns
For i = 1 To rst.Fields.Count - 1
li.SubItems(i) = CheckNull(rst.Fields(i))
Next

rst.MoveNext 'Move to next record
Loop

'Define os Tamanhos das colunas automaticamente
Call TamanhoColAutomatico

End If
'atualiza o label de mensagens
If rst.RecordCount <= 0 Then
lblMensagens.Caption = rst.RecordCount & " registros encontrados"
Else
lblMensagens.Caption = rst.RecordCount & " registros encontrados"
End If


Exit Sub

' Fecha o conjunto de registros.
Set rst = Nothing
' Fecha a conexão.
'conn.Close

TrataSaida:
Exit Sub
TrataErro:
Debug.Print Err.Description & vbNewLine & Err.Number & vbNewLine & Err.Source
MsgBox Err.Description & vbNewLine & Err.Number & vbNewLine & Err.Source
Resume TrataSaida
End Sub
_______________________________

'Modelo de Aplicativo de Cadastro em VBA no Microsoft Excel
'Autor: Tomás Vásquez
'http://www.tomasvasquez.com.br
'http://tomas.vasquez.blog.uol.com.br
'março de 2008

'Adaptação Mauro Coutinho com LISTVIEW
'Julho de 2011

Option Explicit

'constantes para auxiliar na verificação do código
Private Const Ascendente As Byte = 0
Private Const Descendente As Byte = 1
Private caminhoArquivoDados As String


'INICIO - REDIMENSIONAR AUTOMATICAMENTE COLUNAS DO LISTVIEW
'TamanhoColAutomatico - 'Define os Tamanhos das colunas automaticamente
'http://www.vb6.com.br/29/Controles-Micr ... TVIEW.html
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hWnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Const LVM_FIRST = &H1000
Private Const LVM_SETCOLUMNWIDTH = (LVM_FIRST + 30)
Private Const LVSCW_AUTOSIZE = -1
Private Const LVSCW_AUTOSIZE_USEHEADER = -5
'FIM - REDIMENSIONAR AUTOMATICAMENTE COLUNAS DO LISTVIEW
'Modelo de Aplicativo de Cadastro em VBA no Microsoft Excel
'Autor: Tomás Vásquez
'http://www.tomasvasquez.com.br
'http://tomas.vasquez.blog.uol.com.br
'março de 2008

'Adaptação Mauro Coutinho com LISTVIEW
'Julho de 2011

Const colCodigo_CLIENTE As Integer = 1
Const colCPF_CLIENTE As Integer = 2
Const colRG_CLIENTE As Integer = 3
Const colNome_CLIENTE As Integer = 4
Const colApelido_CLIENTE As Integer = 5
Const colAtivoBioNatura_CLIENTE As Integer = 6
Const colDataNascimento_CLIENTE As Integer = 7
Const colEndereco_CLIENTE As Integer = 8
Const colNumero_CLIENTE As Integer = 9
Const colBairro_CLIENTE As Integer = 10
Const colComplemento_CLIENTE As Integer = 11
Const colCidade_CLIENTE As Integer = 12
Const colUF_CLIENTE As Integer = 13
Const colCEP_CLIENTE As Integer = 14
Const colPorte_CLIENTE As Integer = 15
Const colContato1_CLIENTE As Integer = 16
Const colTelefone1_CLIENTE As Integer = 17
Const colCelular1_CLIENTE As Integer = 18
Const colEmail1_CLIENTE As Integer = 19
Const colContato2_CLIENTE As Integer = 20
Const colTelefone2_CLIENTE As Integer = 21
Const colCelular2_CLIENTE As Integer = 22
Const colEmail2_CLIENTE As Integer = 23
Const colHomePage_CLIENTE As Integer = 24
Const colObservacao_CLIENTE As Integer = 25
Const colArquivo_CLIENTE As Integer = 26

Const indiceMinimo As Byte = 2
Const corDisabledTextBox As Long = -2147483633
Const corEnabledTextBox As Long = -2147483643
Const corAtivoTextBox As Long = &HC0FFFF

Const nomePlanilhaCadastro As String = "Cliente"

Const SW_SHOWMAXIMIZED = 3
Const ERROR_FILE_NOT_FOUND = 2

#If VBA7 Then
Private Declare PtrSafe Function ShellExecute Lib "Shell32.dll" Alias "ShellExecuteA" _
(ByVal hwnd As LongPtr, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, _
ByVal nShowCmd As LongPtr) As LongPtr
#Else
Private Declare Function ShellExecute Lib "Shell32.dll" Alias "ShellExecuteA" _
(ByVal hWnd As Long, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long
#End If

Private wsCadastro As Worksheet 'planilha
Private wbCadastro As Workbook 'pasta
Private indiceRegistro As Long
_______________________________________

[Reinaldo]

Acredito que apenas pelo código ficara muito difícil obter um retorno, não identifiquei na miscelânea acima a rotina que preenche o registro/monta sql/where.
Disponibilize seu modelo, talvez assim consiga um retorno efetivo