Dúvida de manipulação de Data no VBA - Excel 2010

Question

Bom dia galera.

Então, estou montando uma planilha bem simples, mas não estou conseguindo enxergar uma solução para o meu código.

A situação é a seguinte:

Estou criando um código em VBA no excel para gerar um banco de dados em um determinada planilha. Porém, este bando de dados vai ser um Relatório mensal. Então eu gostaria de poupar o trabalho do meu chefe em ter que digitar a data do outro dia toda vez que for registrar uma nova observação. Por exemplo, hoje (17/11/2012) ele inseriu uma observação ( clicando no botão inserir) aí logo em seguinda o textbox cxtData teria que aparecer o dia 18/11/2012 evitando assim o trabalho de entrar com a nova data.

Alguém pode me ajudar?

A planilha segue no link. http://ge.tt/5kCFcnR/v/0?c

Obrigado

Answer 1

Euder, com o VBA é possível fazer coisas que não é possível do jeito normal do Excel, como preencher células de uma planilha que não está selecionada. Você estava ativando uma planilha para povoá-la, não é necessário.

Organize seu código: crie uma rotina que valida os dados, outra que povoa e outra que reseta os valores dos dados no formulário.

Use o código abaixo:

Private Const CMsPrograma As String = "Aviso"

Private Sub botInserir_Click()
    Dim lRow As Long
    
    If fValidar Then Exit Sub

    With ThisWorkbook.Sheets("RM")
        lRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
        .Cells(lRow, "A") = Me.cxtData
        .Cells(lRow, "B") = Me.cxtPoco
        .Cells(lRow, "C") = Me.cxtLocal
        .Cells(lRow, "D") = Me.cxtOperando
        .Cells(lRow, "E") = Me.cxtDtm
        .Cells(lRow, "F") = Me.cxtAguardando
        .Cells(lRow, "G") = Me.cxtGlosa
        .Cells(lRow, "H") = Me.cxtTotal
        .Cells(lRow, "I") = Me.cxtMotivos
    End With
    
    MsgBox "Os dados foram inseridos com sucesso!", vbExclamation, CMsPrograma
    fResetarDados

End Sub

Private Function fValidar() As Boolean
    Dim sMsgBox As String
    
    Select Case True
        Case Not IsDate(Me.cxtData)
            sMsgBox = "Preencha uma data válida!"
        Case Trim(cxtMotivos) = ""
            sMsgBox = "Preencha o campo Motivos!"
    End Select
    If sMsgBox <> "" Then
        MsgBox sMsgBox, vbExclamation, CMsPrograma
        fValidar = True
    End If
End Function

Private Sub fResetarDados()
    cxtOperando = ""
    cxtDtm = ""
    cxtAguardando = ""
    cxtTotal = ""
    cxtMotivos = ""
    If IsDate(cxtData) Then
        cxtData = DateSerial(Year(cxtData), Month(cxtData), Day(cxtData) + 1)
    End If
End Sub

Private Sub btmFechar_Click()
    Unload Me
End Sub

Private Sub cxtTotal_Change()
    cxtTotal = Val(cxtOperando) + Val(cxtAguardando) + Val(cxtGlosa) + Val(cxtDtm)
End Sub

Private Sub UserForm_Initialize()
    cxtData = Date
End Sub

---

Felipe Costa Gualberto - http://www.ambienteoffice.com.br

Answer 2

Benzadeu, perfeito cara!

Só que eu utilizei o exemplo de hoje né. Mas na verdade nunca vamos inserir a data de hoje. Vai ser sempre uma data passada.

Por exemplo, ele vai inserir a data 19/10/2012 e inserir os dados. Depis que inserir a data 20/10/2012 tem que aparecer no cxtData.

Entendeu? =DD

Se for possível, tem como fazer esta mudança pra mim no código? Vou tentando aqui também.

Muitoo obrigado.

ah! Uma vez eu escutei que existe outra maneira de criar interfaces no excel sem for pelo VBA. Você conhece esta outra maneira?

Abraços e fica com Deus, benzadeus.

Answer 3

"Por exemplo, ele vai inserir a data 19/10/2012 e inserir os dados. Depis que inserir a data 20/10/2012 tem que aparecer no cxtData."
O exemplo que disponibilizei já faz isso, não? A parte do código que incrementa a data em um dia é:

    If IsDate(cxtData) Then
        cxtData = DateSerial(Year(cxtData), Month(cxtData), Day(cxtData) + 1)
    End If

Ela pode ser escrita de outra forma mais simples:

    If IsDate(cxtData) Then
        cxtData = cxtData + 1
    End If

"Uma vez eu escutei que existe outra maneira de criar interfaces no excel sem for pelo VBA. Você conhece esta outra maneira?"

Não entendi essa pergunta. Poderia dar mais detalhes?

---

Felipe Costa Gualberto - http://www.ambienteoffice.com.br

Answer 4

Então, o código que você enviou me da a data 17/11/2012 direto.

Quando eu abro a interface o campo DATA já está preenchido pela data acima.

Quando eu apago e escrevo outra ele aceita. Porém quando vou executar novamente, a data 17/11/2012 volta a preencher o campo data.

Entendeu?

Então, escutei falar que existe outra forma de criar essas interface para inserir dados (criar um banco de dados) sem ser pelo VBA, sem utilizar programação. ;s

Obrigado

Answer 5

"Então, escutei falar que existe outra forma de criar essas interface para inserir dados (criar um banco de dados) sem ser pelo VBA, sem utilizar programação. ;s"
Vale a pena aprender VBA. Você consegue fazer mais, com mais eficiência e gastando menos tempo. No entanto, se pretende trabalhar exclusivamente com formulários e banco de dados, a ferramenta adequada é o Access.

Sobre a sua dúvida, sugiro você manter uma célula na planilha como referência, para salvar a última data usada. Por exemplo, escreva a data atual na célula Z1 da planilha RM. No código, altere os subprocedimentos para:

Private Sub UserForm_Initialize()
    cxtData = Format(CLng(ThisWorkbook.Sheets("RM").Range("Z1")), "dd/mm/yyyy")
End Sub

e:

Private Sub fResetarDados()
    cxtOperando = ""
    cxtDtm = ""
    cxtAguardando = ""
    cxtTotal = ""
    cxtMotivos = ""
    If IsDate(cxtData) Then
        ThisWorkbook.Sheets("RM").Range("Z1") = ThisWorkbook.Sheets("RM").Range("Z1") + 1
        cxtData = Format(CLng(ThisWorkbook.Sheets("RM").Range("Z1")), "dd/mm/yyyy")
    End If
End Sub

---

Felipe Costa Gualberto - http://www.ambienteoffice.com.br

Answer 6

Benzadeus, então, fiz as modificações que o senhor sugeriu. Porém continua com o mesmo "problema".

Quando eu executo o código o campo data já está preenchido com a data 17/11/2012 e a medida que eu vou inserindo a data vai aumentando um dia. Beleza, era isto mesmo que eu queria.

Porém, se eu alterar a data para, por exemplo: 20/10/2010, e inserir, depois ele volta para a data 18/11/2012.

E o certo, o que eu gostaria, é que aparecesse a data 21/10/2010 no campo data, e não 18/11/2012.

Vou exemplificar de novo:

Ao executar o código não pode ter nada preenchido no campo data. O usuário vai preencher o campo com a data, exemplo: 10/10/2010, e inserir o dados e clicar no botão inserir. Após inserir a interface volta e no campo data tem que estar preenchido com um dia a mais, neste caso com 11/10/2010.

Entendeu?

Muito obrigado pela atenção.

Answer 7

Benzadeus, 

o senhor conseguiu?

Obrigado

Answer 8

Agora sim entendi o que deseja fazer. Use o código abaixo:

Private Sub botInserir_Click()
    Dim lRow As Long
    
    If fValidar Then Exit Sub

    With ThisWorkbook.Sheets("RM")
        lRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
        .Cells(lRow, "A") = Me.cxtData
        .Cells(lRow, "B") = Me.cxtPoco
        .Cells(lRow, "C") = Me.cxtLocal
        .Cells(lRow, "D") = Me.cxtOperando
        .Cells(lRow, "E") = Me.cxtDtm
        .Cells(lRow, "F") = Me.cxtAguardando
        .Cells(lRow, "G") = Me.cxtGlosa
        .Cells(lRow, "H") = Me.cxtTotal
        .Cells(lRow, "I") = Me.cxtMotivos
    End With
    
    MsgBox "Os dados foram inseridos com sucesso!", vbExclamation, CMsPrograma
    fResetarDados

End Sub

Private Function fValidar() As Boolean
    Dim sMsgBox As String
    
    Select Case True
        Case Not IsDate(Me.cxtData)
            sMsgBox = "Preencha uma data válida!"
        Case Trim(cxtMotivos) = ""
            sMsgBox = "Preencha o campo Motivos!"
    End Select
    If sMsgBox <> "" Then
        MsgBox sMsgBox, vbExclamation, CMsPrograma
        fValidar = True
    End If
End Function

Private Sub fResetarDados()
    cxtOperando = ""
    cxtDtm = ""
    cxtAguardando = ""
    cxtTotal = ""
    cxtMotivos = ""
    If IsDate(cxtData) Then
        cxtData = CDate(cxtData) + 1
    End If
End Sub

Private Sub btmFechar_Click()
    Unload Me
End Sub

Private Sub cxtTotal_Change()
    cxtTotal = Val(cxtOperando) + Val(cxtAguardando) + Val(cxtGlosa) + Val(cxtDtm)
End Sub

Não é necessário me chamar de senhor, tenho 29 anos.

---

Felipe Costa Gualberto - http://www.ambienteoffice.com.br

Answer 9

PERFEITO Benzadeus. Era disto que eu estava falando. hehe

Muuito Obrigado.

Se você tive mais um tempo, tente me ajudar nestas duas partes aqui:

1. O valor da soma (no cxtTotal) referente a cxtOperando, cxtGlosa, cxtDtm e cxtAguardando não aparece automático no cxtTotal. Por exemplo: EU VOU DIGITANDO OS VALORES NOS cxtOperando, cxtGlosa, cxtDtm e cxtAguardando E NO cxtTotal VAI ME DAR A SOMA DOS VALORES INSERIDOS NESTAS TEXTBOX. PORÉM PARA QUE O VALOR APARECE NA cxtTotal EU TENHO QUE DIGITAR ALGO NO TEXTBOX. ELE NAO APARECE AUTOMATICO, A MEDIDADE QUE VOU INSERINDO OS VALORES NAS OUTRAS TEXTBOX. Deu para entender? rs

2. Os valores das  cxtOperando, cxtGlosa, cxtDtm , cxtAguardando e cxtTotal são redirecionados para a planilha RM, né? Porém quando isso acontece aparece um ponto VERDE em cada célula (Plan. RM) indicando um erro e pedindo para formatar como número. Isto interfere no fim da planilha RM, porque com estes pontos verdes nas células não é possível somar seus valores. Tem como inserir os valores nas textbox e não ter este erro?

Só serão inseridos valores numericos nelas.

Obrigadoo... =D

Answer 10

Private Const CMsPrograma As String = "Aviso"

Private Sub botInserir_Click()
    Dim lRow As Long
    
    If fValidar Then Exit Sub

    With ThisWorkbook.Sheets("RM")
        lRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
        .Cells(lRow, "A") = CLng(CDate(Me.cxtData))
        .Cells(lRow, "B") = CDbl(Val(Me.cxtPoco))
        .Cells(lRow, "C") = CDbl(Val(Me.cxtLocal))
        .Cells(lRow, "D") = CDbl(Val(Me.cxtOperando))
        .Cells(lRow, "E") = CDbl(Val(Me.cxtDtm))
        .Cells(lRow, "F") = CDbl(Val(Me.cxtAguardando))
        .Cells(lRow, "G") = CDbl(Val(Me.cxtGlosa))
        .Cells(lRow, "H") = CDbl(Val(Me.cxtTotal))
        .Cells(lRow, "I") = CDbl(Val(Me.cxtMotivos))
    End With
    
    MsgBox "Os dados foram inseridos com sucesso!", vbExclamation, CMsPrograma
    fResetarDados

End Sub

Private Function fValidar() As Boolean
    Dim sMsgBox As String
    
    Select Case True
        Case Not IsDate(Me.cxtData)
            sMsgBox = "Preencha uma data válida!"
        Case Trim(cxtMotivos) = ""
            sMsgBox = "Preencha o campo Motivos!"
    End Select
    If sMsgBox <> "" Then
        MsgBox sMsgBox, vbExclamation, CMsPrograma
        fValidar = True
    End If
End Function

Private Sub fResetarDados()
    cxtOperando = ""
    cxtDtm = ""
    cxtAguardando = ""
    cxtTotal = ""
    cxtMotivos = ""
    If IsDate(cxtData) Then
        cxtData = CDate(cxtData) + 1
    End If
End Sub

Private Sub btmFechar_Click()
    Unload Me
End Sub

Private Sub cxtAguardando_Change()
    AtualizarTotal
End Sub

Private Sub cxtDtm_Change()
    AtualizarTotal
End Sub

Private Sub cxtGlosa_Change()
    AtualizarTotal
End Sub

Private Sub cxtOperando_Change()
    AtualizarTotal
End Sub

Private Sub AtualizarTotal()
    Dim txt As Variant
    Dim dValor As Double
    Dim dTotal As Double
    For Each txt In Controls
        Select Case txt.Name
            Case "cxtAguardando", "cxtDtm", "cxtGlosa", "cxtOperando"
                If Len(Trim(txt)) > 0 Then
                    If IsNumeric(txt) Then
                        dTotal = dTotal + txt
                    End If
                End If
        End Select
    Next txt
    cxtTotal = dTotal
End Sub

---

Felipe Costa Gualberto - http://www.ambienteoffice.com.br

Answer 11

Benzadeu, perfeito! Muito obrigado.

Mas a função de soma que está dentro do cxtTotal não funciona corretamente.

Estou inserindo

cxtOperando: 10

cxtGlosa: 10,5

Ai o cxtTotal tem que dar: 20,5

mas na verdade da: 20.

Obrigado

Answer 12

Benzadeus, você conseguiu achar o erro?

Answer 13

O erro estava na função Val, que eu não removi antes.

Option Explicit

Private Const CMsPrograma As String = "Aviso"

Private Sub botInserir_Click()
    Dim lRow As Long
    
    If fValidar Then Exit Sub

    With ThisWorkbook.Sheets("RM")
        lRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
        .Cells(lRow, "A") = CLng(CDate(Me.cxtData))
        .Cells(lRow, "B") = Me.cxtPoco
        .Cells(lRow, "C") = Me.cxtLocal
        If Me.cxtOperando <> "" Then .Cells(lRow, "D") = CDbl(Me.cxtOperando) Else .Cells(lRow, "D") = 0
        If Me.cxtDtm <> "" Then .Cells(lRow, "E") = CDbl(Me.cxtDtm) Else .Cells(lRow, "E") = 0
        If Me.cxtAguardando <> "" Then .Cells(lRow, "F") = CDbl(Me.cxtAguardando) Else .Cells(lRow, "F") = 0
        If Me.cxtGlosa <> "" Then .Cells(lRow, "G") = CDbl(Me.cxtGlosa) Else .Cells(lRow, "G") = 0
        If Me.cxtTotal <> "" Then .Cells(lRow, "H") = CDbl(Me.cxtTotal) Else .Cells(lRow, "H") = 0
        .Cells(lRow, "I") = Me.cxtMotivos
    End With
    
    MsgBox "Os dados foram inseridos com sucesso!", vbExclamation, CMsPrograma
    fResetarDados

End Sub

Private Function fValidar() As Boolean
    Dim sMsgBox As String
    
    Select Case True
        Case Not IsDate(Me.cxtData)
            sMsgBox = "Preencha uma data válida!"
        Case Trim(cxtMotivos) = ""
            sMsgBox = "Preencha o campo Motivos!"
    End Select
    If sMsgBox <> "" Then
        MsgBox sMsgBox, vbExclamation, CMsPrograma
        fValidar = True
    End If
End Function

Private Sub fResetarDados()
    cxtOperando = ""
    cxtDtm = ""
    cxtAguardando = ""
    cxtTotal = ""
    cxtMotivos = ""
    If IsDate(cxtData) Then
        cxtData = CDate(cxtData) + 1
    End If
End Sub

Private Sub btmFechar_Click()
    Unload Me
End Sub

Private Sub cxtAguardando_Change()
    AtualizarTotal
End Sub

Private Sub cxtDtm_Change()
    AtualizarTotal
End Sub

Private Sub cxtGlosa_Change()
    AtualizarTotal
End Sub

Private Sub cxtOperando_Change()
    AtualizarTotal
End Sub

Private Sub AtualizarTotal()
    Dim txt As Variant
    Dim dValor As Double
    Dim dTotal As Double
    For Each txt In Controls
        Select Case txt.Name
            Case "cxtAguardando", "cxtDtm", "cxtGlosa", "cxtOperando"
                If Len(Trim(txt)) > 0 Then
                    If IsNumeric(txt) Then
                        dTotal = dTotal + txt
                    End If
                End If
        End Select
    Next txt
    cxtTotal = dTotal
End Sub

---

Felipe Costa Gualberto - http://www.ambienteoffice.com.br

Answer 14

Benzadeus,

não funcionou. O cxtTotal não da o valor correto da soma e não está inserindo o valor correto no planilha RM.

=SS

Answer 15

Comigo está funcionando normalmente. Verifique um exemplo pronto: https://skydrive.live.com/redir?resid=FB206A2D510E0661!653

---

Felipe Costa Gualberto - http://www.ambienteoffice.com.br