Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Dados em celulas c ...
 
Notifications
Clear all

Dados em celulas c sinalização verde, canto super. esquerdo

 
2024 - VBA & Macros
Post Recente por AMORIM123 7 anos atrás
3 Posts
2 Usuários
0 Reactions
908 Visualizações
RSS
AMORIM123
 AMORIM123
(@amorim123)
Posts: 77
Trusted Member
Topic starter
 

Boa tarde galera do fórum.

Galera, estou com a seguinte questão:

Em meu Frm_estoque há uma rótina de cód cujo objetivo é cadastrar informações na minha sheets("Dados"), porém antes de realizar o cadastro, é verificado através de loop se já algum cadastro repetido (o parametrô para isso é "período" & "empresa"), se sim é perguntado ao usuário se deseja sobrescrever as informações, se não é feito novo cadastro; estando meus txtbox preenchidos e a verificação de cadastro já existente, ok ...o cadastro é feito, porém as células que armazenam os dados digitados em meus txtbox estão com uma sinalização verde no canto superior esquerdo (mensagem: "O número nesta célula é formatado como texto ou precedido por apóstrofo").

Já mudei as própriedades dos txtbox de text para value, já formatei as colunas que recebem os valores como "contábil", no entanto ainda não consegui resolver essa questão.

Quem puder ajudar, segue a planilha em anexo!

link dropbox: https://www.dropbox.com/s/d14rlr8b478un9b/060418_CALCULO%20ESTOQUE%20-%20babdallas.xlsm?dl=0

tamanho da planilha 757kb

Desde já obrigado pela atenção.

 
Postado : 16/04/2018 11:04 am
 klarc28
(@klarc28)
Posts: 971
Prominent Member
 
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
    
    With Me
        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
    
    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
        
        
        If resultado = 0# Then
            .Cells(lngUltLinDados + 1, 8).Value = Format(VBA.Round((resultado) * 1000, 2), "0.00") & "%"
        Else
            .Cells(lngUltLinDados + 1, 8).Value = Format(VBA.Round((resultado) * 100, 2), "0.00") & "%"
        End If
        

    
    
        If resultado <= 0.8 Then
            
            .Cells(lngUltLinDados + 1, 9).Value = "OK"
        Else
            .Cells(lngUltLinDados + 1, 9).Value = "CMV<20%"
        End If
    
        txt_resultado.Value = .Cells(lngUltLinDados + 1, 8).Value
        
        MsgBox ("Resultado MVA% = " & .Cells(lngUltLinDados + 1, 8).Value & " , STATUS: " & .Cells(lngUltLinDados + 1, 9).Value & "")
        
        
    End With
    
    
    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


    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




Private Sub UserForm_Initialize()


Application.ScreenUpdating = False

With frm_estoque

.txt_empresa.SetFocus
.btn_calcular.Enabled = True

Call limpar

End With

Application.ScreenUpdating = True

End Sub

Private Sub limpar()

txt_empresa = ""
txt_periodo = ""
txt_ei = ""
txt_comras = ""
txt_ef = ""
txt_vendas = ""
txt_resultado = ""
txt_observacoes = ""


End Sub
Private Sub btn_consultar_Click()
frm_consulta.Show
End Sub
Sub numeracao_automatica()
Dim I

       I = wshDados.Cells(Rows.Count, 1).End(xlUp).Row + 1
       For j = 2 To I
            If IsNumeric(wshDados.Cells(j - 1, 1)) Then
                 wshDados.Cells(j, 1) = wshDados.Cells(j - 1, 1) + 1
            Else
                 wshDados.Cells(j, 1) = 1
            End If
       Next
   End Sub

Private Sub txt_periodo_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    txt_periodo.MaxLength = 10
    Select Case KeyAscii
        Case 8
        Case 13: SendKeys "{TAB}"
        Case 48 To 57
        If txt_periodo.SelStart = 2 Then txt_periodo.SelText = "/"
        If txt_periodo.SelStart = 5 Then txt_periodo.SelText = "/"
        Case Else: KeyAscii = 0
    End Select
End Sub


Private Sub txt_ei_Change()

'créditos do código - Bruno Sobral (http://excelevba.com.br/formato-moeda-no-textbox-enquanto-digita/)

valor = txt_ei.Value
    If IsNumeric(valor) Then
        If InStr(1, valor, "-") >= 1 Then valor = Replace(valor, "-", "") 'retira sinal negativo
        If InStr(1, valor, ",") >= 1 Then valor = CDbl(Replace(valor, ",", "")) 'retirar a virgula
        If InStr(1, valor, ".") >= 1 Then valor = Replace(valor, ".", "") 'para trabalhar melhor retiramos ponto
        Select Case Len(valor) 'verifica casas para inserção de ponto
            Case 1
            numPonto = "00" & valor
            Case 2
            numPonto = "0" & valor
            Case 6 To 8
            numPonto = Left(valor, Len(valor) - 5) & "." & Right(valor, 5)
            Case 9 To 11
            numPonto = inseriPonto(8, valor)
            Case 12 To 14
            numPonto = inseriPonto(11, valor)
            Case Else
            numPonto = valor
        End Select
        numVirgula = Left(numPonto, Len(numPonto) - 2) & "," & Right(numPonto, 2)
        txt_ei.Value = numVirgula
    Else
        If valor = "" Then Exit Sub
        MsgBox "Número invalido", vbCritical, "Caracter Invalido"
        Exit Sub
    End If

End Sub

Private Sub txt_compras_Change()

valor = txt_compras.Value
    If IsNumeric(valor) Then
        If InStr(1, valor, "-") >= 1 Then valor = Replace(valor, "-", "") 'retira sinal negativo
        If InStr(1, valor, ",") >= 1 Then valor = CDbl(Replace(valor, ",", "")) 'retirar a virgula
        If InStr(1, valor, ".") >= 1 Then valor = Replace(valor, ".", "") 'para trabalhar melhor retiramos ponto
        Select Case Len(valor) 'verifica casas para inserção de ponto
            Case 1
            numPonto = "00" & valor
            Case 2
            numPonto = "0" & valor
            Case 6 To 8
            numPonto = Left(valor, Len(valor) - 5) & "." & Right(valor, 5)
            Case 9 To 11
            numPonto = inseriPonto(8, valor)
            Case 12 To 14
            numPonto = inseriPonto(11, valor)
            Case Else
            numPonto = valor
        End Select
        numVirgula = Left(numPonto, Len(numPonto) - 2) & "," & Right(numPonto, 2)
        txt_compras.Value = numVirgula
    Else
        If valor = "" Then Exit Sub
        MsgBox "Número invalido", vbCritical, "Caracter Invalido"
        Exit Sub
    End If

End Sub

Private Sub txt_ef_Change()

valor = txt_ef.Value
    If IsNumeric(valor) Then
        If InStr(1, valor, "-") >= 1 Then valor = Replace(valor, "-", "") 'retira sinal negativo
        If InStr(1, valor, ",") >= 1 Then valor = CDbl(Replace(valor, ",", "")) 'retirar a virgula
        If InStr(1, valor, ".") >= 1 Then valor = Replace(valor, ".", "") 'para trabalhar melhor retiramos ponto
        Select Case Len(valor) 'verifica casas para inserção de ponto
            Case 1
            numPonto = "00" & valor
            Case 2
            numPonto = "0" & valor
            Case 6 To 8
            numPonto = Left(valor, Len(valor) - 5) & "." & Right(valor, 5)
            Case 9 To 11
            numPonto = inseriPonto(8, valor)
            Case 12 To 14
            numPonto = inseriPonto(11, valor)
            Case Else
            numPonto = valor
        End Select
        numVirgula = Left(numPonto, Len(numPonto) - 2) & "," & Right(numPonto, 2)
        txt_ef.Value = numVirgula
    Else
        If valor = "" Then Exit Sub
        MsgBox "Número invalido", vbCritical, "Caracter Invalido"
        Exit Sub
    End If

End Sub


Private Sub txt_vendas_Change()
valor = txt_vendas.Value
    If IsNumeric(valor) Then
        If InStr(1, valor, "-") >= 1 Then valor = Replace(valor, "-", "") 'retira sinal negativo
        If InStr(1, valor, ",") >= 1 Then valor = CDbl(Replace(valor, ",", "")) 'retirar a virgula
        If InStr(1, valor, ".") >= 1 Then valor = Replace(valor, ".", "") 'para trabalhar melhor retiramos ponto
        Select Case Len(valor) 'verifica casas para inserção de ponto
            Case 1
            numPonto = "00" & valor
            Case 2
            numPonto = "0" & valor
            Case 6 To 8
            numPonto = Left(valor, Len(valor) - 5) & "." & Right(valor, 5)
            Case 9 To 11
            numPonto = inseriPonto(8, valor)
            Case 12 To 14
            numPonto = inseriPonto(11, valor)
            Case Else
            numPonto = valor
        End Select
        numVirgula = Left(numPonto, Len(numPonto) - 2) & "," & Right(numPonto, 2)
        txt_vendas.Value = numVirgula
    Else
        If valor = "" Then Exit Sub
        MsgBox "Número invalido", vbCritical, "Caracter Invalido"
        Exit Sub
    End If
End Sub

Function inseriPonto(inicio, valor)
    I = Left(valor, Len(valor) - inicio)
    M1 = Left(Right(valor, inicio), 3)
    M2 = Left(Right(valor, 8), 3)
    F = Right(valor, 5)
    If (M2 = M1) And (Len(valor) < 12) Then
    inseriPonto = I & "." & M1 & "." & F
    Else
    inseriPonto = I & "." & M1 & "." & M2 & "." & F
    End If
End Function
 
Postado : 16/04/2018 11:20 am
AMORIM123
 AMORIM123
(@amorim123)
Posts: 77
Trusted Member
Topic starter
 

Obrigado meu caro..."CCur "

 
Postado : 16/04/2018 11:47 am
Forum Jump:
  Tópico Anterior
Próximo Tópico