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

  • Pergunta

  • 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

    sábado, 17 de novembro de 2012 12:25

Respostas

Todas as Respostas

  • 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

    sábado, 17 de novembro de 2012 18:24
    Moderador
  • 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.

    sábado, 17 de novembro de 2012 19:18
  • "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

    sábado, 17 de novembro de 2012 19:28
    Moderador
  • 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

    sábado, 17 de novembro de 2012 19:35
  • "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

    sábado, 17 de novembro de 2012 20:15
    Moderador
  • 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.

    sábado, 17 de novembro de 2012 20:31
  • Benzadeus, 

    o senhor conseguiu?

    Obrigado

    domingo, 18 de novembro de 2012 10:20
  • 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

    domingo, 18 de novembro de 2012 12:43
    Moderador
  • 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

    domingo, 18 de novembro de 2012 14:04
  • 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

    domingo, 18 de novembro de 2012 17:31
    Moderador
  • 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

    domingo, 18 de novembro de 2012 17:47
  • Benzadeus, você conseguiu achar o erro?
    segunda-feira, 19 de novembro de 2012 14:30
  • 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

    segunda-feira, 19 de novembro de 2012 21:24
    Moderador
  • 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

    terça-feira, 20 de novembro de 2012 10:26
  • Comigo está funcionando normalmente. Verifique um exemplo pronto: https://skydrive.live.com/redir?resid=FB206A2D510E0661!653

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

    segunda-feira, 26 de novembro de 2012 22:33
    Moderador