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
