none
Loop venda RRS feed

  • Pergunta

  • Boa tarde a todos!

    Estou aqui novamente para pedir uma ajuda. Tenho o código abaixo que coloquei em um formulário e ele funciona da seguinte forma:

    aparece uma lista de produto, seleciono um produto, logo aparece o valor unitário, informo a quantidade através do inputbox, ele faz a multiplicação, mostra um resumo e escreve na planilha. Até ai tudo bem.

    O problema é que se uma mesma pessoa fizer o pedido de dois produtos diferentes eu não consigo fazer a soma do valor dos dois pedidos, como poderia fazer isso com este código ou outro?

    Private Sub apaga()

     'limpar formulário para o proxímo cadastro
        LbCarro = ""
        TbDesconto = ""
        TbValor = ""
        TbValorTotal = ""
        Tbvunitario = ""
        Tbquantidade = ""
        Tbvtotal = ""
        Tbtdesconto = ""
        LbResumo.Clear
     Exit Sub

    End Sub

    Private Sub BtCancelar_Click()
        
        apaga
        
    End Sub

    Private Sub BtOK_Click()

    'cofere dados do userform
        If LbCarro.Text = "" Then
            MsgBox "ESCOLHA UM PRODUTO", vbCritical, "Alerta"
            LbCarro.SetFocus
            Exit Sub
        End If
        
    'verificar linha vazia para escrever no relatorio de vendas
        Sheets("Relatório de Vendas").Select
            If Range("A2") = "" Then
                linha = 2
            Else
                Range("A1").Select
                    Selection.End(xlDown).Select
                    linha = ActiveCell.Row + 1
            End If
    'escreve cadastra os dados
        Cells(linha, 1) = linha - 1
        Cells(linha, 2) = Date
        Cells(linha, 3) = LbCarro.Text
    'escreve quantidade
        Cells(linha, 4) = Tbquantidade.Text
    'valorunitário
        Cells(linha, 5) = Tbvunitario.Text
    'valor Total
        Cells(linha, 6) = Tbvtotal.Text
    'valor desconto
        Cells(linha, 7) = Tbtdesconto.Text
        'If ObAutomatico = True Then
    'desconto
        Cells(linha, 8) = desconto
        Cells(linha, 8) = TbDesconto
    'valo
        valor = Mid(TbValor, 3)
        valor = CCur(valor)
        Cells(linha, 9) = valor
        
    'limpar formulário para o proxímo cadastro
            
        apaga
            
    End Sub

    Private Sub LbCarro_Change()

        calculapreco
        atualizaresumo
        

    End Sub

    Private Sub atualizaresumo()

    'limpa lista
        LbResumo.Clear
        
     'carro
         If LbCarro = "" Then 'nome vazio
            LbResumo.AddItem "PRODUTO NÃO IDENTIFICADO"
            Else
            LbResumo.AddItem "PRODUTO:  " & LbCarro.Value
        End If

    'valor unitário
         If Tbvunitario = "" Then 'nome vazio
            LbResumo.AddItem "VALOR NÃO INFORMADO"
            Else
            LbResumo.AddItem "V. UNIT  " & Tbvunitario.Value
        End If

    'quantidade
        If Tbquantidade = "" Then 'nome vazio
            LbResumo.AddItem "QUANTIDADE NÃO INFORMADA"
            Else
            LbResumo.AddItem "QUANTIDADE  " & Tbquantidade.Value
        End If


    'valor total
         If Tbvtotal = "" Then 'nome vazio
            LbResumo.AddItem "VALOR NÃO INFORMADO"
           Else
            LbResumo.AddItem "V. TOTAL  " & Tbvtotal.Value
         End If
        
    'Total do desconto
         If Tbtdesconto = "" Then 'nome vazio
            LbResumo.AddItem "VALOR NÃO INFORMADO"
          Else
            LbResumo.AddItem "T. DESCONTO  " & Tbtdesconto.Value
            
         End If
    End Sub

    Private Sub SbDesconto_Change()

        TbDesconto = SbDesconto
        TbDesconto = Format(TbDesconto / 100, "0%")
        calculapreco
        
    End Sub

    Private Sub Tbtdesconto_Change()
      
      atualizaresumo

    End Sub


    Private Sub UserForm_Initialize()

        Sheets("Userform").Select 'Seleciona a aba onde contem as informações
        
    'carro
        Range("A2").Select 'célula de início
        Selection.End(xlDown).Select
        linha = ActiveCell.Row
        lista = "Userform!A2:A" & (linha) 'verifica qual a última linha preechida
        LbCarro.RowSource = lista

        Sheets("Relatório de Vendas").Select 'Seleciona a aba onde contem as informações
        

    End Sub

    Sub calculapreco()
        Dim valorcarro As Currency
        Dim valormodelo As Currency
        Dim valortotal As Currency
        Dim valorcambio As Currency
        Dim valoropcionais As Currency
        
    'carro
        If LbCarro.Text = "" Then
            Exit Sub
        Else
            carro = LbCarro.Value 'item selecionado na lista de carro
            Sheets("Userform").Select 'seleciona a aba
            Cells.Find(carro).Activate
            linha = ActiveCell.Row 'indentifica a linha ativa
            col = ActiveCell.Column 'identifiva a coluna ativa
            valorcarro = Cells(linha, 2) 'acessa o valo do carro
            Tbvunitario = Cells(linha, 2)
            Tbvunitario = Format(Tbvunitario, "R$ #,##0.00") 'valor calculado no txtbox valo
        
        End If
             
    'caixa texto quantidade
             
        If Tbquantidade = "" Then
             Tbquantidade = InputBox("Quantidade?")
             
    'checa se foi insrido número
        
        ultimo = Right(Tbquantidade, 1) 'último caracter inserido
        tamanho = Len(Tbquantidade)
          If Not IsNumeric(ultimo) And tamanho > 0 Then
                Tbquantidade = Left(Tbquantidade, tamanho - 1) ' apaga letras
                MsgBox "DIGITE APENAS NÚMERO PARA A QUANTIDADE", vbCritical, "Alerta"
                            
            apaga
            
                Exit Sub
        
         End If
        
       End If
        
    'valor total - soma carro modelo cambio e opcionais
        valortotal = valorcarro * Tbquantidade
            
        Tbvtotal = valortotal
        Tbvtotal = Format(Tbvtotal, "R$ #,##0.00") 'valor calculado no txtbox valo
      
    'desconto
        Dim desconto As Single
        
            If TbDesconto = "" Then
                desconto = 0
            Else
                tamanho = Len(TbDesconto)
                desconto = Left(TbDesconto, tamanho - 1)
                desconto = CSng(desconto) 'converte o texto para número
                desconto = desconto / 100
            End If
        
        valortotal = valortotal * (1 - desconto)
        
        
        TbValor = Format(valortotal, "R$ #,##0.00") 'valor calculado no txtbox valo
        TbValorTotal = Format(valortotal, "R$ #,##0.00") 'valor calculado no txtbox valo
        Tbtdesconto = Tbvtotal - TbValorTotal
        Tbtdesconto = Format(Tbtdesconto, "R$ #,##0.00") 'valor calculado no txtbox valo
        
        
    End Sub

    grato

    sábado, 6 de julho de 2013 18:45