[Resolvido] Sistema de Acesso

[nereu1301 0]

Bom dia

 

Estou tentando implementar o Sistema de Controle de Acesso, que encontrei aqui no Imaster, que por sinal é muito interessante, mas estou tendo problema na sub abaixo, que retorna erro de "Tipos diferentes" sinalizando na linha sublinhada.

 

' rotina que preenche o ListView com os usuários já cadastrados no banco
Private Sub montarLista()
Dim lstUsuaria As ListItem
    With rsUsuarios
        .Open "select * from Usuarios order by nome", cnn, adOpenKeyset, adLockOptimistic
        'limpar lista
        LstViewUsuario.ListItems.Clear
        'carregar a lista
        [u]Set lstUsuaria = LstViewUsuario.ListItems.Add(, , "<Novo>")[/u]            
            If .EOF Then
                MsgBox "Não existem usuários cadastrados no sistema.", vbExclamation
            Else
                Do Until rsUsuarios.EOF
                Set lstUsuaria = LstViewUsuario.ListItems.Add(, , rsUsuarios("Usuario"))
                    lstUsuaria.Tag = rsUsuarios("Cod_Usuario")
                    lstUsuaria.SubItems(1) = rsUsuarios("Nome")
                    lstUsuaria.SubItems(2) = rsUsuarios("Dpto")
                    lstUsuaria.SubItems(3) = rsUsuarios("Cargo")
                    lstUsuaria.SubItems(4) = rsUsuarios("Senha")
                    rsUsuarios.MoveNext
                Loop
            End If
        .Close
    End With
End Sub

Já procurei a soluçaão em diversos lugares, mas aparentemente está tudo certo.

 

alguem poderia me dar uma dica de onde eu possa estar errando??

 

Nereu

[Mário Monteiro 179]

qual a linha do erro exatamente?

[nereu1301 0]

Bom dia Mario

 

o erro 13 ocorre nesta linha

Set lstUsuaria = LstViewUsuario.ListItems.Add(, , "<Novo>")

 

Fui na tabela e coloquei os dados diretos na tabela ai em execução ele informa lstUsuaria como nothing e no Do Until rsUsuarios.EOF aparecem os dados que coloquei na tabela.

 

Nereu

[nereu1301 0]

boa tarde

 

primeiro problema resolvi

Eu estava usando biblioteca errada nessa outra sub

 

Private Sub ListView1_ItemClick(ByVal item As ComctlLib.ListItem)

 

Agora o problema sinaliza nestas linhas

lstUsuaria.SubItems(1) = rsUsuarios("Nome")

lstUsuaria.SubItems(2) = rsUsuarios("Dpto")

lstUsuaria.SubItems(3) = rsUsuarios("Cargo")

lstUsuaria.SubItems(4) = rsUsuarios("Senha")

 

erro 380 "Invalid property value"

 

sigo precisando de ajuda

 

Nereu

[scorpio 7]

Tenta converter para string antes de colocar o valor.

[nereu1301 0]

Boa tarde

 

Não entendi, porque oque me sinaliza é que a propriedade subItems não é válida?

Oque eu devo converter em string?

 

Desculpe meu desconhecimento, mas fiz diversas tentativas e não deram certas.

 

Nereu

[scorpio 7]

"Invalid property value"

Seria algo como "valor para a propriedade é inválido".

 

 

Assim:

lstUsuaria.SubItems(1) = CStr(rsUsuarios("Nome"))

[nereu1301 0]

Bom dia Scorpio

 

Infelizmente retornou o mesmo erro.

 

Nereu

[nereu1301 0]

Bom dia Scorpio

 

Infelizmente retornou o mesmo erro.

 

Nereu

 

Testei o Incluir e o Excluir e tudo funciona, o problema é que ele não tá mostrando os sub items no form. Quando abro o formulario ele só mostra la os Usuario e CodUsuarios que não são subItems.

 

Não sei se me expliquei direito

 

Nereu

[nereu1301 0]

Boa Noite

 

Resolvido

 

Descobri, no Macoratti(ADO , ListView e mais...) que pra usar subitems precisa da presença do objeto ColumnHeaders e ai o codigo ficou assim:

 

Private Sub montarLista()

Dim lstUsuaria As ListItem

 

With rsUsuarios

.Open "select * from Usuarios order by nome", cnn, adOpenKeyset, adLockOptimistic

'limpar lista

ListView1.ListItems.Clear

listview1_cabecalho

'carregar a lista

Set lstUsuaria = ListView1.ListItems.Add(, , "<Novo>")

If .EOF Then

MsgBox "Não existem usuários cadastrados no sistema.", vbExclamation

Else

Do Until rsUsuarios.EOF

Set lstUsuaria = ListView1.ListItems.Add(, , rsUsuarios("Usuario"))

lstUsuaria.Tag = rsUsuarios("Cod_Usuario")

lstUsuaria.SubItems(1) = rsUsuarios("Nome")

lstUsuaria.SubItems(2) = rsUsuarios("Dpto")

lstUsuaria.SubItems(3) = rsUsuarios("Cargo")

lstUsuaria.SubItems(4) = rsUsuarios("Senha")

rsUsuarios.MoveNext

Loop

End If

.Close

End With

Call limpar

End Sub

 

e ficou muito bom. Obrigado a todos.

 

Nereu