AMORIM123,
Adicione a instrução On Error Resume Next no bloco que define o valor de cada variável. O erro ocorre devido á tentativa de converter o valor txtPeriodo que está em branco (nulo) como Data. Mantenha a orientação que passei anteriormente, adicionando apenas esta instrução ao bloco que segue :
With Me
'Havendo erro, continue
On Error Resume Next
datPeriodo = .txt_periodo.Text
strEmpresa = .txt_empresa.Text
ei = .txt_ei.Text
compras = .txt_compras.Text
ef = .txt_ef.Text
vendas = .txt_vendas.Text
strObservacoes = .txt_observacoes.Text
End With
Outra forma de tratar este erro seria :
Private Sub btn_calcular_Click()
Dim quantidade, sv1, sv2 As Long
Dim strEmpresa, strObservacoes, strBusca As String
Dim datPeriodo As Date
Dim ei, compras, ef, vendas As Currency
Dim resultado As Double
Dim novoRegistro As Boolean
Dim lngUltLinDados, lngPriLinDados, lngLoopLin As Long
lngPriLinDados = 2
With wshDados
lngUltLinDados = .Cells(.Rows.Count, 2).End(xlUp).Row
End With
trataErro:
'TRATAMENTO DE DADOS PARA IMPEDIR O CADSTRO SEM O PREENCHIMENTO DE ALGUNS TXTBOX
With Me
If .txt_periodo = "" Then
MsgBox ("Preenchimento imconpleto! Insira Período"), vbExclamation, aviso
.txt_periodo.SetFocus
Exit Sub
ElseIf .txt_empresa = "" Then
MsgBox ("Preenchimento imconpleto! Insira Empresa"), vbExclamation, aviso
.txt_empresa.SetFocus
Exit Sub
ElseIf .txt_ei = "" Then
MsgBox ("Preenchimento imconpleto! Insira EI"), vbExclamation, aviso
.txt_ei.SetFocus
Exit Sub
ElseIf .txt_compras = "" Then
MsgBox ("Preenchimento imconpleto! Insira Compras"), vbExclamation, aviso
.txt_compras.SetFocus
Exit Sub
ElseIf .txt_ef = "" Then
MsgBox ("Preenchimento imconpleto! Insira EF"), vbExclamation, aviso
.txt_ef.SetFocus
Exit Sub
ElseIf .txt_vendas = "" Then
MsgBox ("Preenchimento imconpleto! Insira Vendas"), vbExclamation, aviso
.txt_vendas.SetFocus
Exit Sub
End If
End With
With Me
'Havendo erro na conversão, vá para
'o parágrafo de tratamento
On Error GoTo trataErro
datPeriodo = .txt_periodo.Text
strEmpresa = .txt_empresa.Text
ei = .txt_ei.Text
compras = .txt_compras.Text
ef = .txt_ef.Text
vendas = .txt_vendas.Text
strObservacoes = .txt_observacoes.Text
End With
novoRegistro = True
'FAZ A VARREDURA NA PLANILHA EM BUSCA POR DADOS IDENTICOS
With wshDados
For lngLoopLin = lngPriLinDados To lngUltLinDados Step 1
strBusca = wshDados.Cells(lngLoopLin, 2) & wshDados.Cells(lngLoopLin, 3)
If strBusca = datPeriodo & strEmpresa Then
If MsgBox("Empresa " & strEmpresa & " já cadastrado para o " & datPeriodo & " , deseja sobrescreve-lo?!", vbYesNo) = vbYes Then
.Cells(lngLoopLin, 2) = datPeriodo
.Cells(lngLoopLin, 3) = strEmpresa
.Cells(lngLoopLin, 4) = CCur(ei)
.Cells(lngLoopLin, 5) = CCur(compras)
.Cells(lngLoopLin, 6) = CCur(ef)
.Cells(lngLoopLin, 7) = CCur(vendas)
.Cells(lngLoopLin, 10) = strObservacoes
novoRegistro = False
' Else
' novoRegistro = False
' Exit Sub
End If
novoRegistro = False
End If
Next lngLoopLin
If novoRegistro = True Then
Call numeracao_automatica
.Cells(lngUltLinDados + 1, 2) = datPeriodo
.Cells(lngUltLinDados + 1, 3) = strEmpresa
.Cells(lngUltLinDados + 1, 4) = CCur(ei)
.Cells(lngUltLinDados + 1, 5) = CCur(compras)
.Cells(lngUltLinDados + 1, 6) = CCur(ef)
.Cells(lngUltLinDados + 1, 7) = CCur(vendas)
.Cells(lngUltLinDados + 1, 10) = strObservacoes
Else
Exit Sub
End If
sv1 = CDbl(.Cells(lngUltLinDados + 1, 6).Value2) + CDbl(.Cells(lngUltLinDados + 1, 7).Value2)
sv2 = CDbl(.Cells(lngUltLinDados + 1, 4).Value2) + CDbl(.Cells(lngUltLinDados + 1, 5).Value2)
resultado = (sv1 - sv2) / .Cells(lngUltLinDados + 1, 7).Value2
.Cells(lngUltLinDados + 1, 8).Value = resultado
.Cells(lngUltLinDados + 1, 8).NumberFormat = "0.00%"
If resultado <= 0.8 Then
.Cells(lngUltLinDados + 1, 9).Value = "OK"
Else
.Cells(lngUltLinDados + 1, 9).Value = "CMV<20%"
End If
txt_resultado.Value = Format(.Cells(lngUltLinDados + 1, 8).Value, "#.#0%")
MsgBox ("Resultado MVA% = " & Format(.Cells(lngUltLinDados + 1, 8).Value, "#.#0%") & " , STATUS: " & .Cells(lngUltLinDados + 1, 9).Value & "")
End With
If MsgBox("Dados cadastrados com sucesso! Deseja realizar um novo registro?!", vbYesNo) = vbYes Then
Call UserForm_Initialize
Exit Sub
Else
Unload Me
frm_estoque.Show
End If
End Sub
Assim, se houver erro na conversão de qualquer campo, forçamos o retorno ao bloco de validação.
Abs
Postado : 18/04/2018 12:17 pm