Visual Basic 6 : Datas , Datas e mais datas...


  Hoje veremos como calcular a idade de uma pessoa. 

Bem, eu já tratei deste assunto nos artigos :

Por isto este artigo será bem direto e objetivo.  Vou mostrar como fazer cálculos com datas. Antes de começar vou falar sobre uma função muito importante : DateSerial

DateSerial retorna um tipo de dado Variant (Date) para um ano , mês e dia especificado. Sua sintaxe é : DateSerial(year, month, day)

Seus argumentos são :

Parte Descrição
year Obrigatório; Inteiro(Integer).Número entre 100 e 9999, ou uma expressão numérica
month Obrigatório; Inteiro(Integer). Qualquer expressão numérica.
day Obrigatório.Inteiro(Integer). Qualquer expressão numérica.

Para definir uma data , como 31 de dezembro de 1991 , o intervalo de números para cada argumento da função deverá ser inserido no intervalo aceito por cada um deles. Assim para dias (day) o intervalo válido é de 1 a 31 , para mêses (month) o intervalo válido é de 1 a 12.

Você também pode usar expressões numéricas para cada argumento.

Então podemos fazer: DateSerial(1990 - 10, 8 - 2, 1 - 1)

Esta função irá retornar uma data :

No argumento ano , valores entre 0 e 29 , são interpretados como para o intervalo de anos de 2000 a 2029. Valores entre 30 e 99 são interpretados como intervalo de anos entre 1930 a 1999. Para outros intervalos ou valores para o argumento ano(year) use um valor com 4 dígitos : 1850.

Nota: Se você exceder o valor para os intervalos válidos haverá um incremento para o próximo valor , assim , se você informar 35 para o argumento dias ele será avaliado como um mês mais alguns dias dependendo do ano. Se você informar um valor maior que o intervalo -32.768/32.767 vai ocorrer um erro.

Lembre-se que o tipo de dado Time/Date é armazenado como um número de precisão dupla (double-precision) e se você não tomar cuidado poderá obter resultados incorretos ao tentar manipular valores de data e hora em uma expressão.

Agora , usando a função DateSerial , que tal alguns cálculos com datas ? Vamos lá...

- Primeiro dia do mês atual

        DateSerial(Year(Date), Month(Date), 1)


- Primeiro dia do próximo mês

        DateSerial(Year(Date), Month(Date) + 1, 1)
 

- Último dia do mês atual

        DateSerial(Year(Date), Month(Date) + 1, 0)
 

- Último dia do próximo mês

        DateSerial(Year(Date), Month(Date) + 2, 0)
 

- Primeiro dia do mês anterior

        DateSerial(Year(Date), Month(Date) - 1, 1)
 

- Último dia do mês anterior

        DateSerial(Year(Date), Month(Date), 0)

 

- Primeiro dia semana atual (Domingo)

        Date - Weekday(Date) + 1

 

- Primeiro dia semana atual (Domingo)

          Date - Weekday(Date) + 7

 

- Quantos dias há no mês (11 refere-se a novembro)

    Datepart("d", DateSerial(2003,11 + 1, 0))

Private Sub Command1_Click(Index As Integer)
Dim data As Date

Select Case Index
Case 0
   data = DateSerial(Year(Date), Month(Date), 1)
Case 1
  data = DateSerial(Year(Date), Month(Date) + 1, 1)
Case 2
  data = DateSerial(Year(Date), Month(Date) + 1, 0)
Case 3
  data = DateSerial(Year(Date), Month(Date) + 2, 0)
Case 4
  data = DateSerial(Year(Date), Month(Date) - 1, 1)
Case 5
  data = DateSerial(Year(Date), Month(Date), 0)
Case 6
  data = Date - Weekday(Date) + 1
Case 7
  data = Date - Weekday(Date) + 7
End Select
MsgBox Command1(Index).Caption & " => " & data, vbInformation, "Data hora atual = > " & Now()
End Sub

Calculando intervalo de horas

Como as horas são armazenadas como uma fração de 24 , se você tentar somar , subtrair , multiplicar ou dividir intervalos de horas maiores que 24 você vai obter resultados incorretos. Exemplo :

Private Sub Command2_Click()
 

Dim dataincial As Date
Dim datafinal As Date

 

datainicial = #6/1/1993 8:00:00 AM#
datafinal = #6/3/1993 1:00:00 PM#
 

MsgBox Format(datafinal - datainicial, "hh:mm")

 

End Sub

- O código ao lento tenta calcular a diferença em horas entre os dias 01/6 a 03/06 e vai dar o resultado final como sendo de 05:00  quando na verdade o resultado correto seria 53:00.

Para resolver este problema você deve usar as funções Int() e CSng() para separar o valor do tempo em diferentes variávies para dias , horas , minutos e segundos.

A seguir temos uma função que calcula o intervalo de tempo para valores maiores que 24 horas e expressa em dias , horas , minutos e segundos.

Function calculaIntervaloTempo(intervalo)

Dim totalHoras As Long
Dim totalMinutos As Long
Dim totalSegundos As Long

Dim dia As Long, horas As Long, minutos As Long, segundos As Long

dias = Int(CSng(intervalo))
totalHoras = Int(CSng(intervalo * 24))
totalMinutos = Int(CSng(intervalo * 1440))
totalSegundos = Int(CSng(intervalo * 86400))

horas = totalHoras Mod 24
minutos = totalMinutos Mod 60
segundos = totalSegundos Mod 60

calculaIntervaloTempo = dias & " dias " & horas & " Horas " & minutos & " Minutos " & segundos & " Segundos "

End Function
 

Se você usar a função para obter o resultado do intervalo de tempo para o exemplo acima:

 

Dim dataincial As Date
Dim datafinal As Date

 

datainicial = #6/1/1993 8:00:00 AM#
datafinal = #6/3/1993 1:00:00 PM#

 

CalculaIntervaloTempo(datafinal-datainicial)

 

Vai obter o resultado: 2 dias 5 horas 0 minutos 0 segundos ou seja 53 horas.

Se você quiser o resultado em horas basta usar a seguinte função: CalculaIntervaloHoras(datafinal-datainicial)

Function CalculaIntervaloHoras(intervalo)
 

Dim resultado As Double
CalculaIntervaloHoras = Int(CSng(intervalo * 24))


End Function

Se você quiser o resultado em segundos  basta usar a seguinte função: CalculaIntervaloSegundos(datafinal-datainicial)

Function CalculaIntervaloSegundos(intervalo)
 

Dim resultado As Double
CalculaIntervaloSegundos = Int(CSng(intervalo * 24 * 3600))


End Function

Precisando de outros cálculos ???

1 - Quantos dias faltam para uma determinada data ?

Private Sub calculaDias()
Dim data As String

data = InputBox("Digite uma data : Use o formato: DD/MM/AAAA (15/11/2003) ")

If data <> "" Then
    If IsDate(data) Then
       MsgBox "Faltam " & DateDiff("d", Now, data) & " dias " & " até " & data, vbInformation, "Data atual => " &  Format(Now(), "dd/mm/yyyy")
    Else
        MsgBox " Data Inválida ", vbCritical
    End If
End If
End Sub

2 - Quantos dias úteis existem entre duas datas ? (Não leva em conta feriados , somente sábados e domingos)

Function CalculaDiasUteis(dataInicio As Variant, dataFinal As Variant) As Integer

Dim intSemanas As Integer
Dim varDataCont As Variant
Dim intFimDias As Double

dataInicio = DateValue(dataInicio)
dataFinal = DateValue(dataFinal)

intSemanas = DateDiff("w", dataInicio, dataFinal)
varDataCont = DateAdd("ww", intSemanas, dataInicio)

intFimDias = 0

Do While varDataCont < dataFinal

  'desconta os sábados e domingos
   If Format(varDataCont, "ddd") <> "Sun" And Format(varDataCont, "ddd") <> "Sat" Then
       intFimDias = intFimDias + 1
   End If
   varDataCont = DateAdd("d", 1, varDataCont)
Loop

CalculaDiasUteis = intSemanas * 5 + intFimDias
End Function

3- Calcular a idade em anos de uma pessoa ?

Public Function Idade(nascimento As Date, hoje As Date) As Integer

If Month(hoje) < Month(nascimento) Or (Month(hoje) = Month(nascimento) And  Day(hoje) < Day(nascimento)) Then
    Idade = Year(hoje) - Year(nascimento) - 1
Else
   Idade = Year(hoje) - Year(nascimento)
End If
End Function

4- Calcular a idade em anos e meses de uma pessoa ?

Private Function calcula_idade(nascimento As Date) As String


Dim dias As Single
Dim anos As Integer
Dim meses As Integer
Dim resto As Integer
 

dias = DateDiff("d", CVDate(nascimento), Now)
anos = Int(dias / 365)
resto = dias Mod 365
meses = Int(resto / 30)
dias = resto Mod 30
 

calcula_idade = anos & " anos " & meses & " mes(es)

 

End Function

4- Precisando calcular datas fora do intervalo suportado ???

Você sabe que a função DateSerial somente suporta cálculos entre datas para o intervalo de datas entre 01 de janeiro de 100 até 31 de dezembro de 9999. Abaixo uma função que faz cálculos fora deste  intervalo:

Function astroDay(ano, mes, dia)
Dim y As Double

y = ano + (mes - 2.85) / 12

astroDay = Int(Int(Int(367 * y) - 1.75 * Int(y) + dia) - 0.75 * Int(0.01 * y)) + 1721119

End Function
 

Ex: msgbox (astroDay(120000, 11, 25) - astroDay(120000, 11, 23))   ==>  irá exibir 2.

referências:

HOW-TO : Find Number of Days Between Dates outside of Normal range

ACC2000 : Functions for calculating and displaying date/time values

E por hoje é só até mais...

Veja os Destaques e novidades do SUPER DVD Visual Basic (sempre atualizado) : clique e confira !

Quer migrar para o VB .NET ?

Quer aprender C# ??

Quer aprender os conceitos da Programação Orientada a objetos ?

Quer aprender o gerar relatórios com o ReportViewer no VS 2013 ?

  Gostou ?   Compartilhe no Facebook   Compartilhe no Twitter

Referências:


José Carlos Macoratti