UPDATE COM LOOP NO LISTVIEW

 Tópico anterior Próximo tópico Novo tópico

UPDATE COM LOOP NO LISTVIEW

VB / VBA

 Compartilhe  Compartilhe  Compartilhe
#477535 - 31/10/2017 13:35:55

WMR2018
BALSAS
Cadast. em:Outubro/2017


Boa Tarde pessoal

Preciso fazer um update numa tabela, baseado nos itens marcados num listview

A ideia seria consultar na tabela Usuario, o "Usuario" com o campo "Login" igual ao exibido no "combo1"

Ai baseado nos checkbox marcado do listview de cada linha, ele iria atualizar os campos na tabela USUARIO daquele "login=combo1"

Fiz mais ou menos assim, mais nao dar certo,

O que tá faltando?



UPDATE usuario SET WHERE (login = '" & Combo1 & "')


For i = 1 To ListView1.ListItems.Count
        If ListView1.ListItems.Item(i).Text = "Clientes - Inclusão" Then
            rsUsuario.Fields("cliinc") = IIf(ListView1.ListItems.Item(i).Checked = True, "1", "0")
        ElseIf ListView1.ListItems.Item(i).Text = "Clientes - Alteração" Then
            rsUsuario.Fields("clialt") = IIf(ListView1.ListItems.Item(i).Checked = True, "1", "0")
        ElseIf ListView1.ListItems.Item(i).Text = "Clientes - Exclusão" Then
            rsUsuario.Fields("cliexc") = IIf(ListView1.ListItems.Item(i).Checked = True, "1", "0")
        ElseIf ListView1.ListItems.Item(i).Text = "Produtos - Inclusão" Then
            rsUsuario.Fields("prodinc") = IIf(ListView1.ListItems.Item(i).Checked = True, "1", "0")
        ElseIf ListView1.ListItems.Item(i).Text = "Produtos - Alteração" Then
            rsUsuario.Fields("prodalt") = IIf(ListView1.ListItems.Item(i).Checked = True, "1", "0")
        ElseIf ListView1.ListItems.Item(i).Text = "Produtos - Exclusão" Then
            rsUsuario.Fields("prodexc") = IIf(ListView1.ListItems.Item(i).Checked = True, "1", "0")
        End If
Next

rsUsuario.Update


uso VB6 + SQLServer2008



Resposta escolhida #477537 - 31/10/2017 14:35:41

OMAR2011
MONTES CLAROS
Cadast. em:Setembro/2011


Use o próprio Lstviiew para faze o Update.



#477541 - 31/10/2017 18:53:13

OMAR2011
MONTES CLAROS
Cadast. em:Setembro/2011


 Anexos estao visíveis somente para usuários registrados

Verifica este exemplo e faz modificação ao seu gosto.



#477542 - 31/10/2017 21:19:51

WMR2018
BALSAS
Cadast. em:Outubro/2017


Citação:
:
Verifica este exemplo e faz modificação ao seu gosto.

basicamente o exemplo é de exemplos de exibição no listview... no meu caso seria edição:

A Ideia seria exibir dados no listview, marcar/desmarcar o que quiser, e depois clicar no botão para salvar... entao fiz assim:

Public Sub ListarUsuario()
Dim sSQL As String

sSQL = "SELECT *, login, codigo FROM usuario ORDER BY codigo"
Set rsUsuario = dbData.OpenRecordset(sSQL)

Do While Not rsUsuario.EOF
    cboLogin.AddItem rsUsuario.Fields("login")
    cboLogin.ItemData(cboLogin.NewIndex) = rsUsuario("codigo")
    rsUsuario.MoveNext
Loop
End Sub


Private Sub Command1_Click()
If MsgBox("Confirma a alteração no perfil de acesso?", vbQuestion + vbYesNo + vbDefaultButton2, "Controle de Acesso") = vbYes Then
    
    rsUsuario.MoveFirst
    rsUsuario.Find "login='" & cboLogin & "'"
    
    If Not rsUsuario.EOF Then
       Call GravarAcesso
    Else
        MsgBox "Ocorreu um erro ao localizar usuário!", vbExclamation, "Acesso"
    End If
End If
End Sub


Sub GravarAcesso()
For i = 1 To ListView1.ListItems.Count
        If ListView1.ListItems.Item(i).Text = "Clientes - Inclusão" Then
            rsUsuario.Fields("cliinc") = IIf(ListView1.ListItems.Item(i).Checked = True, "1", "0")
        ElseIf ListView1.ListItems.Item(i).Text = "Clientes - Alteração" Then
            rsUsuario.Fields("clialt") = IIf(ListView1.ListItems.Item(i).Checked = True, "1", "0")
        ElseIf ListView1.ListItems.Item(i).Text = "Clientes - Exclusão" Then
            rsUsuario.Fields("cliexc") = IIf(ListView1.ListItems.Item(i).Checked = True, "1", "0")
        ElseIf ListView1.ListItems.Item(i).Text = "Produtos - Inclusão" Then
            rsUsuario.Fields("prodinc") = IIf(ListView1.ListItems.Item(i).Checked = True, "1", "0")
        ElseIf ListView1.ListItems.Item(i).Text = "Produtos - Alteração" Then
            rsUsuario.Fields("prodalt") = IIf(ListView1.ListItems.Item(i).Checked = True, "1", "0")
        ElseIf ListView1.ListItems.Item(i).Text = "Produtos - Exclusão" Then
            rsUsuario.Fields("prodexc") = IIf(ListView1.ListItems.Item(i).Checked = True, "1", "0")
        End If
Next
rsUsuario.Update
MsgBox "Perfil de acesso cadastrado!", vbInformation, "Perfil"
End Sub


o erro tá dando na subrotina GravarAcesso, pois ela diz que o comando que tô usando não permita "atualizar" os dados



#477557 - 01/11/2017 15:31:55

OMAR2011
MONTES CLAROS
Cadast. em:Setembro/2011


Que tipo de campo da tabela é

rsUsuario.Fields("cliinc")
rsUsuario.Fields("clialt")



#477559 - 01/11/2017 16:46:55

WMR2018
BALSAS
Cadast. em:Outubro/2017


Citação:
:
Que tipo de campo da tabela é

rsUsuario.Fields("cliinc")
rsUsuario.Fields("clialt")

tipo: int



#477560 - 01/11/2017 17:21:26

OMAR2011
MONTES CLAROS
Cadast. em:Setembro/2011


O projeto que lhe enviei você consegue editar uma célula do Listiview.
Executa e clica no terceiro botão e tenta editar clicando em Stock e Baja.
Usei e modifiquei deste jeito para editar com checkbox  sim ou não,accesse.

Private Sub Command7_Click()
On Error GoTo error_Sub

    Dim rs As ADODB.Recordset
    
    Set rs = New ADODB.Recordset
    rs.CursorLocation = adUseClient
    
    
    rs.Open "Select *  from perfis", conexao, adOpenStatic, adLockOptimistic
    rs.MoveFirst
    
    Dim item As ListItem
    Dim i As Integer
    While Not rs.EOF
        i = i + 1
        Set item = ListView1.ListItems(i)
        If ListView1.ListItems.item(i).Checked Then
      
            rs(5) = 1
            rs(6) = 1
            rs(7) = 1
            rs(8) = 1
            rs(9) = 1
           ' rs(6) = 1
            rs.Update
            rs.MoveNext
            Else
            rs(5) = 0
            rs(6) = 0
            rs(7) = 0
            rs(8) = 0
            rs(9) = 0
            'rs(6) = 1
            rs.Update
            rs.MoveNext
            End If
    Wend
    
    rs.Close
    Set rs = Nothing
    
Exit Sub
error_Sub:
MsgBox Err.Description
End Sub



 Tópico anterior Próximo tópico Novo tópico


Tópico encerrado, respostas não sao permitidas
Encerrado por WMR2018 em 01/11/2017 21:11:51