Este fórum está sendo desativado

[SandroLima]

Bom dia, amigos forumeiros.

Poderiam me ajudar com uma sub-rotina para retornar a diferença em anos e meses entre duas datas.

O Código abaixo traz a informação em anos mas não consegui completar para informar os meses.

Se possível gostaria de considerar a possibilidade do valor unitário também... de trazer a palavra mês (no singular) caso a diferença seja igual a 1 e meses caso seja superior a 1.

O mesmo vale para ano... trazer ano "quando" a diferença for igual a 01 e "anos" quando for superior a 01.

Private Sub txt_DataNasc_AfterUpdate()
txt_Idade = DateDiff("yyyy", txt_DataNasc.Value, Date) & " anos e " & " meses"
End Sub

Muito obrigado quem a quem puder colaborar.

[gfranco]

Bom dia.
Veja se o que fiz te ajuda.

[osvaldomp]

Me parece que este comando que você está utilizando não retorna o número correto de anos ~~~> txt_Idade = DateDiff("yyyy", txt_DataNasc.Value, Date)
Faça um teste ~~~> MsgBox DateDiff("yyyy", [A1], Date)
se colocar em A1 ~~~> 30/10/2016 ele retorna 2 anos

Experimente o código abaixo.
Faça os testes inicialmente colocando a data inicial em A1 e se os resultados forem satisfatórios aí substitua [A1] por txt_DataNasc.Value e MsgBox por txt_Idade =

Código: Selecionar todos

Sub teste()
 Dim m As Long, a As Long, dob As Date, san As String, sme As String
 dob = [A1] 'substitua por txt_DataNasc.Value
 a = Year(Date) - Year(dob)
 m = Month(Date) - Month(dob)
 If m < 0 Then m = 12 - (Month(dob) - Month(Date)): a = a - 1
 If Day(Date) < Day(dob) Then m = m - 1
 san = IIf(a <= 1, "ano", "anos"): sme = IIf(m <= 1, "mês", "meses")
 MsgBox a & " " & san & " e " & m & " " & sme  'substitua por txt_Idade = 
End Sub

obs. ao pegar a data na TextBox poderá ocorrer erro pois o VBA pega datas no formato mm/dd/aa, aí será preciso usar o Format para extrair a data

[Reinaldo]

Vide tambem em http://www.planilhando.com.br/forum/vie ... 9&t=29131#

Me parece que este comando que você está utilizando não retorna o número correto de anos

O

Datediff tem uma peculiaridade, conforme alertada em seu help VBA, que deve ser levada em consideração

Ao comparar 31 de dezembro com 1º de janeiro do ano imediatamente seguinte, DateDiff para Ano ("yyyy") retornará 1, mesmo que tenha se passado apenas um dia

Assim é preciso uma comparação simples, para que a mesma seja correta> Se Primeira Data+numero de anos for maior que a SegundaData, subtrai 1 ano

[SandroLima]

Boa tarde, pessoal

Obrigado pela colaboração de vcs... mas preciso novamente de sua ajuda.

Tentei a adaptação de ambos os códigos aqui sugeridos para a minha situação e não consegui finalizar... resolvi colocar a planilha em vez de somente o código para ficar melhor o meu entendimento.

Se puderem me ajudar com mais um problema que estou tendo... notem que sempre a primeira vez que for digitado no campo data... após o segundo dígito ele desabilita a tecla NumLock e isso não é algo desejado.
Não sei pq também o motivo mas o código não permite a tecla BackSpace apagar as barras separadoras dos valores numéricos das datas ("/").

Obrigado se puderem continuar me ajudando

[SandroLima]

Boa tarde

Consegui eliminar o problema de desabilitar a tecla NumLock e o do BackSpace que não apagava os separadores (ou barras - "/" ) com o código seguinte:

Código: Selecionar todos

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

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

Foram utilizados para a TextBox Data e TextBox DataNasc.

Agora só preciso ajustar o código para a TextBox Idade (txt_Idade).

Obrigado quem puder continuar ajudando.

[osvaldomp]

Faça os testes inicialmente colocando a data inicial em A1

Código: Selecionar todos

Private Sub txt_DataNasc_AfterUpdate()
 Dim m As Long, a As Long, dob As Date, san As String, sme As String
  dob = txt_DataNasc.Value
  a = Year(Date) - Year(dob)
  m = Month(Date) - Month(dob)
  If m < 0 Then m = 12 - (Month(dob) - Month(Date)): a = a - 1
  If Day(Date) < Day(dob) And m >= 1 Then m = m - 1
  san = IIf(a <= 1, "ano", "anos"): sme = IIf(m <= 1, "mês", "meses")
  txt_Idade = a & " " & san & " e " & m & " " & sme
End Sub

[SandroLima]

Bom dia, colegas forumeiros

Bom dia GFranco e Osvaldomp e obrigado pela imensa colaboração.

Ajustei o código de vcs conforme minha necessidade. Criei a variável para a data de cadastro (pode ser diferente da data atual). Pode ser diferente do dia em que o sistema será informado.

Osvaldomp... Apenas para efeitos de aprendizado poderia acrescentar o comentário nessas duas linhas? O que significa ":"nas expressões abaixo?

If m < 0 Then m = 12 - (Month(dob) - Month(Date)): a = a - 1

san = IIf(a <= 1, "ano", "anos"): sme = IIf(m <= 1, "mês", "meses")

E dentro do mesmo tema data trouxe o seguinte código para que ele traga por padrão a data de hoje na data de cadastro

Código: Selecionar todos

Private Sub UserForm_Initialize()

txt_Data = Date

End Sub

Qual a linha de comando para que ele selecione o conteúdo da TextBox deixando pronta para edição se necessário.
Lembrei do

txt_Data.SetFocus

Mas ele apenas retorna para a TextBox e não seleciona o conteúdo.

[osvaldomp]

Osvaldomp... Apenas para efeitos de aprendizado poderia acrescentar o comentário nessas duas linhas? O que significa ":"nas expressões abaixo?
If m < 0 Then m = 12 - (Month(dob) - Month(Date)): a = a - 1
san = IIf(a <= 1, "ano", "anos"): sme = IIf(m <= 1, "mês", "meses")

A colocação de dois pontos (:) permite a colocação de múltiplas instruções em uma linha do código.
Assim, If m < 0 Then m = 12 - (Month(dob) - Month(Date)): a = a - 1 equivale às quatro linhas abaixo.
If m < 0 Then
m = 12 - (Month(dob) - Month(Date))
a = a - 1
End If