Guru do Excel e Power BI

Fórum de Dúvidas sobre Excel e Power BI
https://gurudoexcel.com/

Ajuda com VBA gerando erro

https://gurudoexcel.com/viewtopic.php?t=15062

Página 1 de 1

Ajuda com VBA gerando erro

Enviado: 01 Mai 2021 às 13:38
por DennerSantos
Galera preciso de uma ajuda tenho uma planilha para controlar as compras da minha loja criei aos poucos com algumas coisas que vi no fóruns e com ajuda de vocês aqui e ela estava funcionando mais agora quando clico no botão para cadastrar um novo pagamento ele gera um erro e ate que as informações são lançadas na planilha porem ele fecha a useform

Esse é o erro
Imagem


eu acho que é alguma coisa na parcela 2 mais não consegui resolver, alguém poderia me ajudar... segue a baixa o vba para ajudar
Teste Fornecedor.xlsm
Código: Selecionar todos
Private Sub CommandButton1_Click()
'Desativar atualização de ecrã
Application.ScreenUpdating = False

'Ativar a primeira planilha
ThisWorkbook.Worksheets("Vencimentos").Activate

'Procurar a primeira linha vazia
ultimaLinha = ThisWorkbook.Worksheets("Vencimentos").Cells(Rows.Count, 1).End(xlUp).Row
ultimaLinha = ultimaLinha + 1

'Carregar os dados digitados nas caixas de texto para a planilha
With ThisWorkbook.Worksheets("Vencimentos")
    Cells(ultimaLinha, 1).Value = nf.Value
    Cells(ultimaLinha, 2).Value = ComboBox2.Value
    Cells(ultimaLinha, 3).Value = ComboBox1.Value
    Cells(ultimaLinha, 4).Value = Format(data.Value, "DD/MM/YYYY")
    Cells(ultimaLinha, 5).Value = CDbl(txValor.Value)
    Cells(ultimaLinha, 6).Value = txParcela.Value
    Cells(ultimaLinha, 7).Value = parcela1.Value
    Cells(ultimaLinha, 9).Value = parcela2.Value
    Cells(ultimaLinha, 11).Value = parcela3.Value
    Cells(ultimaLinha, 13).Value = parcela4.Value
    Cells(ultimaLinha, 15).Value = parcela55.Value
    Cells(ultimaLinha, 17).Value = parcela6.Value
    Cells(ultimaLinha, 19).Value = parcela7.Value
    Cells(ultimaLinha, 21).Value = parcela8.Value
    Cells(ultimaLinha, 8).Value = CDbl(Valor1.Value)
    Cells(ultimaLinha, 10).Value = CDbl(Valor2.Value)
    Cells(ultimaLinha, 12).Value = CDbl(Valor3.Value)
    Cells(ultimaLinha, 14).Value = CDbl(Valor4.Value)
    Cells(ultimaLinha, 16).Value = CDbl(Valor5.Value)
    Cells(ultimaLinha, 18).Value = CDbl(Valor6.Value)
    Cells(ultimaLinha, 20).Value = CDbl(Valor7.Value)
    Cells(ultimaLinha, 22).Value = CDbl(Valor8.Value)
End With


'Limpar as caixas de texto
txValor.Value = Empty
nf.Value = Empty
ComboBox1.Value = Empty
ComboBox2.Value = Empty
data.Value = Empty
txParcela.Value = Empty
parcela1.Value = Empty
parcela2.Value = Empty
parcela3.Value = Empty
parcela4.Value = Empty
parcela55.Value = Empty
parcela6.Value = Empty
parcela7.Value = Empty
parcela8.Value = Empty
Valor1.Value = Empty
Valor2.Value = Empty
Valor3.Value = Empty
Valor4.Value = Empty
Valor5.Value = Empty
Valor6.Value = Empty
Valor7.Value = Empty
Valor8.Value = Empty
DATA1.Value = Empty
DATA2.Value = Empty
DATA3.Value = Empty
DATA4.Value = Empty
DATA5.Value = Empty
DATA6.Value = Empty
DATA7.Value = Empty
DATA8.Value = Empty
'Colocar o foco na primeira caixa de texto
nf.SetFocus

'Ativar atualização de ecrã
Application.ScreenUpdating = True

'Mensagem de confirmação
MsgBox "Cadastrado com sucesso!", vbOKOnly

End Sub

Private Sub DATA1_Change()
Call somardias1

End Sub
Private Sub DATA2_Change()
Call somardias2

End Sub
Private Sub DATA3_Change()
Call somardias3

End Sub
Private Sub DATA4_Change()
Call somardias4

End Sub
Private Sub DATA5_Change()
Call somardias5

End Sub
Private Sub DATA6_Change()
Call somardias6

End Sub
Private Sub DATA7_Change()
Call somardias7

End Sub
Private Sub DATA8_Change()
Call somardias8

End Sub

Private Sub faturamento_Change()
Call somarfaturamento
End Sub

Private Sub parcela1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim D1, D2 As Double

D1 = Format(data, "000000")
D2 = Format(parcela1, "00000000")


DATA1 = D2 - D1

End Sub
Private Sub parcela2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim D1, D2 As Double

D1 = Format(data, "000000")
D2 = Format(parcela2, "00000000")

DATA2 = D2 - D1

End Sub
Private Sub parcela3_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim D1, D2 As Double

D1 = Format(data, "000000")
D2 = Format(parcela3, "00000000")

DATA3 = D2 - D1

End Sub
Private Sub parcela4_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim D1, D2 As Double

D1 = Format(data, "000000")
D2 = Format(parcela4, "00000000")

DATA4 = D2 - D1

End Sub
Private Sub parcela55_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim D1, D2 As Double

D1 = Format(data, "000000")
D2 = Format(parcela55, "00000000")

DATA5 = D2 - D1

End Sub


Private Sub parcela6_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim D1, D2 As Double

D1 = Format(data, "000000")
D2 = Format(parcela6, "00000000")

DATA6 = D2 - D1

End Sub
Private Sub parcela7_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim D1, D2 As Double

D1 = Format(data, "000000")
D2 = Format(parcela7, "000000")

DATA7 = D2 - D1

End Sub
Private Sub parcela8_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim D1, D2 As Double

D1 = Format(data, "000000")
D2 = Format(parcela8, "000000")

DATA8 = D2 - D1

End Sub
'=================================================================================================================================
'Instrução para efetuar a divisão do valor total frente a quantidade de parcelas
Private Sub txparcela_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim A As Double, B As Integer
Dim Valor As Double, x As Integer

A = txValor.Value
B = txParcela.Value
    
Valorparc = VBA.Round(CDbl(A) / CDbl(B), 2)
        
For x = 1 To B

    Controls.Item("valor" & x).Text = Valorparc
    Controls.Item("valor" & x).Text = Format(Controls.Item("valor" & x), "R$ #,##0.00")

Next
End Sub
'==================================================================================================================================
'Instrução para exibir os valores como moeda
'Private Sub valor1_Change()
'    valor1.Value = Format(valor1, "R$ #,##0.00")
'End Sub
Private Sub txvalor_Exit(ByVal Cancel As MSForms.ReturnBoolean)
        txValor.Value = Format(txValor, "R$ #,##0.00")
End Sub
'Instrução para delimitar a quantidade de caracteres no textbox data
Private Sub data_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    'Limita a Qde de caracteres
    data.MaxLength = 10
   
    'para permitir que apenas números sejam digitados
    If KeyAscii < Asc("0") Or KeyAscii > Asc("9") Then
        KeyAscii = 0
    End If
End Sub
'==================================================================================================================================

'Instrução para inserir as barras no textbox data
Private Sub data_Change()
    'Formata : DD/MM/AAAA
    If Len(data) = 2 Or Len(data) = 5 Then
        data.Text = data.Text & "/"
        SendKeys "{End}", True
    End If
End Sub
Private Sub parcela1_Change()
    'Formata : DD/MM/AAAA
    If Len(parcela1) = 2 Or Len(parcela1) = 5 Then
        parcela1.Text = parcela1.Text & "/"
        SendKeys "{End}", True
    End If
End Sub

Private Sub parcela2_Change()
    'Formata : DD/MM/AAAA
    If Len(parcela2) = 2 Or Len(parcela2) = 5 Then
        parcela2.Text = parcela2.Text & "/"
        SendKeys "{End}", True
    End If
End Sub
Private Sub parcela3_Change()
    'Formata : DD/MM/AAAA
    If Len(parcela3) = 2 Or Len(parcela3) = 5 Then
        parcela3.Text = parcela3.Text & "/"
        SendKeys "{End}", True
    End If
End Sub
Private Sub parcela4_Change()
    'Formata : DD/MM/AAAA
    If Len(parcela4) = 2 Or Len(parcela4) = 5 Then
        parcela4.Text = parcela4.Text & "/"
        SendKeys "{End}", True
    End If
End Sub
Private Sub parcela55_Change()
    'Formata : DD/MM/AAAA
    If Len(parcela55) = 2 Or Len(parcela55) = 5 Then
        parcela55.Text = parcela55.Text & "/"
        SendKeys "{End}", True
    End If
End Sub
Private Sub parcela6_Change()
    'Formata : DD/MM/AAAA
    If Len(parcela6) = 2 Or Len(parcela6) = 5 Then
        parcela6.Text = parcela6.Text & "/"
        SendKeys "{End}", True
    End If
End Sub
Private Sub parcela7_Change()
    'Formata : DD/MM/AAAA
    If Len(parcela7) = 2 Or Len(parcela7) = 5 Then
        parcela7.Text = parcela7.Text & "/"
        SendKeys "{End}", True
    End If
End Sub
Private Sub parcela8_Change()
    'Formata : DD/MM/AAAA
    If Len(parcela8) = 2 Or Len(parcela8) = 5 Then
        parcela8.Text = parcela8.Text & "/"
        SendKeys "{End}", True
    End If
End Sub
Private Sub somardias1()
If IsDate(Me.data) And IsNumeric(Me.DATA1) Then
Me.parcela1 = DateAdd("d", Me.DATA1, Me.data)
End If
End Sub

Private Sub somardias2()
If IsDate(Me.data) And IsNumeric(Me.DATA2) Then
Me.parcela2 = DateAdd("d", Me.DATA2, Me.data)
End If
End Sub

Private Sub somardias3()
If IsDate(Me.data) And IsNumeric(Me.DATA3) Then
Me.parcela3 = DateAdd("d", Me.DATA3, Me.data)
End If
End Sub

Private Sub somardias4()
If IsDate(Me.data) And IsNumeric(Me.DATA4) Then
Me.parcela4 = DateAdd("d", Me.DATA4, Me.data)
End If
End Sub

Private Sub somardias5()
If IsDate(Me.data) And IsNumeric(Me.DATA5) Then
Me.parcela55 = DateAdd("d", Me.DATA5, Me.data)
End If
End Sub

Private Sub somardias6()
If IsDate(Me.data) And IsNumeric(Me.DATA6) Then
Me.parcela6 = DateAdd("d", Me.DATA6, Me.data)
End If
End Sub

Private Sub somardias7()
If IsDate(Me.data) And IsNumeric(Me.DATA7) Then
Me.parcela7 = DateAdd("d", Me.DATA7, Me.data)
End If
End Sub

Private Sub somardias8()
If IsDate(Me.data) And IsNumeric(Me.DATA8) Then
Me.parcela8 = DateAdd("d", Me.DATA8, Me.data)
End If
End Sub

Private Sub somarfaturamento()
If IsDate(Me.data) And IsNumeric(Me.faturamento) Then
Me.data = DateAdd("d", Me.faturamento, Me.data)
End If
End Sub
Private Sub UserForm_Initialize()
data = Date
End Sub

Re: Ajuda com VBA gerando erro

Enviado: 01 Mai 2021 às 17:19
por CursoDeExcelGratis
estimado,
tipos incompativeis é quando é esperado um número e encontra um texto, por exemplo.
no seu caso, a função cdbl não consegue transformar um texto vazio em número, que a gente esperaria que seja 0, experimente mudar
Código: Selecionar todos
    Cells(ultimaLinha, 8).Value = CDbl(Valor1.Value)
    Cells(ultimaLinha, 10).Value = CDbl(Valor2.Value)
    Cells(ultimaLinha, 12).Value = CDbl(Valor3.Value)
    Cells(ultimaLinha, 14).Value = CDbl(Valor4.Value)
    Cells(ultimaLinha, 16).Value = CDbl(Valor5.Value)
    Cells(ultimaLinha, 18).Value = CDbl(Valor6.Value)
    Cells(ultimaLinha, 20).Value = CDbl(Valor7.Value)
    Cells(ultimaLinha, 22).Value = CDbl(Valor8.Value)
para
Código: Selecionar todos

    Cells(ultimaLinha, 8).Value = Val(Valor1.Value)
    Cells(ultimaLinha, 10).Value = Val(Valor2.Value)
    Cells(ultimaLinha, 12).Value = Val(Valor3.Value)
    Cells(ultimaLinha, 14).Value = Val(Valor4.Value)
    Cells(ultimaLinha, 16).Value = Val(Valor5.Value)
    Cells(ultimaLinha, 18).Value = Val(Valor6.Value)
    Cells(ultimaLinha, 20).Value = Val(Valor7.Value)
    Cells(ultimaLinha, 22).Value = Val(Valor8.Value)

Re: Ajuda com VBA gerando erro

Enviado: 05 Mai 2021 às 12:34
por DennerSantos
Coloquei mais não deu certo, acho que o erro esta na seguinte execução quando preencho o campo data com os dias ele calcula a data de hoje + os dias que coloquei no campo data e resultado apresenta no campo parcela

exemplo hoje (05/05/2021) + 35 dias = 10/06/2021
............Data Hoje..................(data).......(Parcela)

quando eu clico em parcela antes de data e o campo esta em branco ai gera o erro acho que teria que colocar uma linha pra nao gerar esse erro quando em branco
Código: Selecionar todos
Private Sub parcela1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim D1, D2 As Double

D1 = Format(data, "000000")
D2 = Format(parcela1, "00000000")


DATA1 = D2 - D1

End Sub
a parte com probelama é essa

Re: Ajuda com VBA gerando erro

Enviado: 07 Mai 2021 às 04:58
por CursoDeExcelGratis
bom dia ! vc poderia colocar um if para verificar se esta vazio ou nao

ou , poderia ignorar os erros se isso não tem problema no seu código

para ignorar os erros é bem facil, seu codigo ficaria assim :
Código: Selecionar todos
Private Sub parcela1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
on error goto Fim
Dim D1, D2 As Double

D1 = Format(data, "000000")
D2 = Format(parcela1, "00000000")


DATA1 = D2 - D1
Fim:
End Sub

Re: Ajuda com VBA gerando erro

Enviado: 07 Mai 2021 às 13:24
por DennerSantos
Amigão deu certo valeu em muito obrigado
Todos os horários são UTC-03:00
Página 1 de 1
Powered by phpBB® Forum Software © phpBB Limited