Ir ao conteúdo
  • Cadastre-se

Maycon Cavalini

Membro Júnior
 Perfil  Explorar Conteúdo

  • Posts

    1

  • Cadastrado em

  • Última visita

 Tipo de conteúdo 

posts postados por Maycon Cavalini

    Ajuda trocar Listview por Listbox

    em Microsoft Office e similares

    Postado

    Bom dia,preciso de ajuda para modificar 3 códigos que foram feitos para Listview.Preciso que me ajudem a modefica-los para Listbox devido ao listview não ter suporte ao office 64bits.Espero que possam me ajudar,segue abaixo os códigos

     

    1º codigo

     

     

    Private Sub carregar_DblClick()
     
     
     
        Dim Buscar As Long
        
        Buscar = CLng(lstvFiltro.SelectedItem.ListSubItems(1).Text)
        SqlOrçDet = "SELECT * FROM tbOrç_Detalhe WHERE Nro_Orçamento = " & Buscar
        SqlOrçGrad = "SELECT * FROM tbOrçamento_Grade WHERE Nro_Orçamento = " & Buscar
        
        rsOrçDet.Close
        rsOrçGrad.Close
        
        rsOrçDet.Open SqlOrçDet, cn, adOpenKeyset, adLockOptimistic
        rsOrçGrad.Open SqlOrçGrad, cn, adOpenKeyset, adLockOptimistic
        
        With frmOrçamento
            .txtNome = rsOrçDet("Nome_Cli")
            If rsOrçDet("Acresc_Desc") = 1 Then
            Else
            End If
            
            With .lstvOrç
            .ListItems.Clear
            For i = 1 To rsOrçGrad.RecordCount
            
                On Error Resume Next
                .ListItems.Add 1, , Format(rsOrçGrad(1), "0")
                On Error Resume Next
                .ListItems(1).ListSubItems.Add 1, , rsOrçGrad(2)
                On Error Resume Next
                .ListItems(1).ListSubItems.Add 2, , Format(rsOrçGrad(3), "")
                On Error Resume Next
                .ListItems(1).ListSubItems.Add 3, , Format(rsOrçGrad(4), "") 'codigo
                On Error Resume Next
                .ListItems(1).ListSubItems.Add 4, , Format(rsOrçGrad(5), "")
                On Error Resume Next
                .ListItems(1).ListSubItems.Add 5, , Format(rsOrçGrad(6), "")
                On Error Resume Next
                .ListItems(1).ListSubItems.Add 6, , Format(rsOrçGrad(7), "")
                On Error Resume Next
                .ListItems(1).ListSubItems.Add 7, , Format(rsOrçGrad(8), "")
                On Error Resume Next
                .ListItems(1).ListSubItems(7).Bold = True
                On Error Resume Next
                rsOrçGrad.MoveNext
                
            Next i
            
            End With
            
            .CalcTotal
            .btnNovo.Enabled = True
            .btnGravar.Enabled = True
            .CommandButton2.Enabled = True
            .btnExcluir.Enabled = True
            NroOrç = rsOrçDet("Nro_Orçamento")
            
        End With
        
        Inc = False
     
        Buscar = CLng(lstvFiltro.SelectedItem.ListSubItems(1).Text)
        SqlOrçDet = "SELECT * FROM tbOrç_Detalhe WHERE Nro_Orçamento = " & Buscar
        SqlOrçGrad = "SELECT * FROM tbOrçamento_Grade WHERE Nro_Orçamento = " & Buscar
        
        rsOrçDet.Close
        rsOrçGrad.Close
        
        rsOrçDet.Open SqlOrçDet, cn, adOpenKeyset, adLockOptimistic
        rsOrçGrad.Open SqlOrçGrad, cn, adOpenKeyset, adLockOptimistic
        
        With frmOrçamento
            .txtNome = rsOrçDet("Nome_Cli")
            If rsOrçDet("Acresc_Desc") = 1 Then
            Else
            End If
            
            With .ListView1
            .ListItems.Clear
            For i = 1 To rsOrçGrad.RecordCount
            
                On Error Resume Next
                .ListItems.Add 1, , Format(rsOrçGrad(1), "0") 'Auxiliar
                On Error Resume Next
                .ListItems(1).ListSubItems.Add 1, , rsOrçGrad(3) 'Quantidade
                On Error Resume Next
                .ListItems(1).ListSubItems.Add 2, , Format(rsOrçGrad(5), "")
                On Error Resume Next
                rsOrçGrad.MoveNext
                
            Next i
            
            End With
            
            .CalcTotal
            .btnNovo.Enabled = True
            .btnGravar.Enabled = True
            NroOrç = rsOrçDet("Nro_Orçamento")
            
        End With
        Inc = False
        Unload Me
        
     
        
    End Sub
     
     
    2º Código
     
     
    Sub carregar()
        
        With Me.lstvFiltro
        
            .ListItems.Clear
            If rsOrçDet.RecordCount > 0 Then
                rsOrçDet.MoveFirst
                For i = 1 To rsOrçDet.RecordCount
                    .ListItems.Add 1, , Format(rsOrçDet("Data"), "dd/mm/yyyy")
                    .ListItems(1).ListSubItems.Add 1, , Format(rsOrçDet("Nro_Orçamento"), "0,00")
                    .ListItems(1).ListSubItems.Add 2, , rsOrçDet("Nome_Cli")
                    .ListItems(1).ListSubItems.Add 3, , Format(rsOrçDet("Total_Liquido"), "currency")
                    rsOrçDet.MoveNext
                    
                Next i
                
            End If
            
        End With
        
           Me.lblReg.Caption = " Registros Encontrados: " & Format(rsOrçDet.RecordCount, "0,00")
           
    End Sub
     
     
     
    3º Código
     
     
    Private Sub btnGravar_Click()
     
    Dim i As Integer
     
        If Me.txtNome = Empty Then
            MsgBox "Digite um nome para esse Detalhamento.", vbExclamation, "Atenção"
            Me.txtNome.SetFocus
            Exit Sub
        End If
        If Not Me.lstvOrç.ListItems.Count > 0 Then
            MsgBox "É necessário incluir pelo menos um Item na Lista" & Chr(13) _
                & ".", vbExclamation, ""
                Me.txtPreTotal.SetFocus
                Exit Sub
        End If
        
            If Inc = True Then
                rsOrçDet.AddNew
            Else
                rsOrçGrad.Close
                SqlOrçGrad = "DELETE FROM tbOrçamento_Grade WHERE Nro_Orçamento = " & NroOrç 'Apaga os registros antigos
                rsOrçGrad.Open SqlOrçGrad, cn, adOpenKeyset, adLockOptimistic               'pra incluir os dados atualizados
               
                SqlOrçGrad = "SELECT * FROM tbOrçamento_Grade"
                rsOrçGrad.Open SqlOrçGrad, cn, adOpenKeyset, adLockOptimistic
                
            End If
            
            rsOrçDet(1) = Date
            rsOrçDet(2) = Me.txtNome
            rsOrçDet(3) = 1
            rsOrçDet(3) = 3
            rsOrçDet(4) = 0
            rsOrçDet(5) = 0
            rsOrçDet.Update
            
            For i = 1 To Me.lstvOrç.ListItems.Count
                With Me.lstvOrç
                    rsOrçGrad.AddNew
                    rsOrçGrad(0) = NroOrç
                    rsOrçGrad(1) = .ListItems(1)
                    rsOrçGrad(2) = .ListItems(i).ListSubItems(1)
                    rsOrçGrad(3) = CDbl(.ListItems(i).ListSubItems(2))
                    rsOrçGrad(4) = CDbl(.ListItems(i).ListSubItems(3))
                    On Error Resume Next
                    rsOrçGrad(5) = CDbl(.ListItems(i).ListSubItems(4))
                    rsOrçGrad.Update
                End With
            Next i
            If Inc = True Then
                rsNro.AddNew
                rsNro(0) = NroOrç
                rsNro.Update
            End If
            
            Inc = False
            LimpaControles
            rsNro.MoveLast
            NroOrç = rsNro(0).Value + 1
             iCancel = 0
     
            
    End Sub
     
     
     
    Aguardo Retono.
     

Sobre o Clube do Hardware

No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas comunidades sobre tecnologia do Brasil. Leia mais

Direitos autorais

Não permitimos a cópia ou reprodução do conteúdo do nosso site, fórum, newsletters e redes sociais, mesmo citando-se a fonte. Leia mais

Mais

×
×
  • Criar novo...

Ebook grátis: Aprenda a ler resistores e capacitores!

EBOOK GRÁTIS!

CLIQUE AQUI E BAIXE AGORA MESMO!