[Resolvido]Diferenca entre datas com Dias, Horas, minutos e segundos...

Tenho uma data na tabela... ja consegui a diferenca dela com a data atual usando o DifDate..

Mas como usar esta funcao para que eu tenha essa diferenca em Dias, Horas, Minutos e Segundos??

Function FormatInterval(ByVal Interval As Variant, Fmt As String)
'
' Formata a diferença entre duas datas ou soma de dois horários para mostrar
' em dias, horas, minutos e segundos
' Suporta os seguintes formatos:
' D H 5 Days 5 Hours
' D H:MM 5 Days 5:15
' D HH:MM 5 Days 05:15
' D H:MM:SS 5 Days 5:15:45
' D HH:MM:SS 5 Days 05:15:45
' H M 125 Hours 15 Minutes
' H:MM 125:15
' H:MM:SS 125:15:45
' M S 7515 Minutes 45 Seconds
'
Dim Days As Long, Hours As Long, Minutes As Long, Seconds As Long
'
' testa para tipos Data (Date) ou dupla precisão (Double)
'
If VarType(Interval) <> 7 And VarType(Interval) <> 5 Then Exit Function
'
' Extrai dias
'
Days = Int(Interval)
Interval = Interval - Days
If Interval > #11:59:59 PM# Then
Days = Days + 1
Interval = 0#
End If
'
' Extrai horas
'
Interval = Interval * 24
Hours = Int(Interval)
Interval = Interval - Hours
If Interval > 3599# / 3600# Then
Hours = Hours + 1
Interval = 0#
End If
'
' Extrai minutos
'
Interval = Interval * 60
Minutes = Int(Interval)
Interval = Interval - Minutes
If Interval > 59# / 60# Then
Minutes = Minutes + 1
Interval = 0#
End If
'
' Extrai segundos
'
Seconds = Int(Interval * 60 + 0.5)
'
' Normaliza
'
If Seconds = 60 Then
Minutes = Minutes + 1
Seconds = 0
End If
If Minutes > 59 Then
Hours = Hours + 1
Minutes = Minutes - 60
End If
If Hours > 23 Then
Days = Days + 1
Hours = Hours - 24
End If
'
' Cria formato
'
Select Case Fmt
Case "D H"
FormatInterval = Days & IIf(Days <> 1, " Days ", " Day ") & Hours & IIf(Hours <> 1, " Hours", " Hour")
Case "D H:MM"
FormatInterval = Days & IIf(Days <> 1, " Days ", " Day ") & Hours & ":" & Format(Minutes, "00")
Case "D HH:MM"
FormatInterval = Days & IIf(Days <> 1, " Days ", " Day ") & Format(Hours, "00") & ":" & Format(Minutes, "00")
Case "D H:MM:SS"
FormatInterval = Days & IIf(Days <> 1, " Days ", " Day ") & Hours & ":" & Format(Minutes, "00") & ":" & Format(Seconds, "00")
Case "D HH:MM:SS"
FormatInterval = Days & IIf(Days <> 1, " Days ", " Day ") & Format(Hours, "00") & ":" & Format(Minutes, "00") & ":" & Format(Seconds, "00")
Case "H M"
Hours = Hours + Days * 24
FormatInterval = Hours & IIf(Hours <> 1, " Hours ", " Hour ") & Minutes & IIf(Minutes <> 1, " Minutes", " Minute")
Case "H:MM"
Hours = Hours + Days * 24
FormatInterval = Hours & ":" & Format(Minutes, "00")
Case "H:MM:SS"
Hours = Hours + Days * 24
FormatInterval = Hours & ":" & Format(Minutes, "00") & ":" & Format(Seconds, "00")
Case "M S"
Minutes = Minutes + (Hours + Days * 24) * 60
FormatInterval = Minutes & IIf(Minutes <> 1, " Minutes ", " Minute ") & Seconds & IIf(Seconds <> 1, " Seconds", " Second")
Case Else
FormatInterval = Null
End Select
End Function

Se você quer apenas a diferença, sem critérios, seria algo assim:

Me.NomeCampo = DateDiff("yyyy", Me.CampoData1, Me.CampoData2) & " anos" & vbCrLf & DateDiff("m", Me.CampoData1, Me.CampoData2) & " meses" & vbCrLf & DateDiff("d", Me.CampoData1, Me.CampoData2) & " dias"

Prezado... A diferença em dias.. eu ja tenho..
Bem Vamos la..
Tenho a Data Inicial Data xx/xx/xx
A data final e a data Sistema: Date()
preciso dessa diferenca em Anos, dias e horas

Seria assim 1 ano, 365 dias e 8760 horas ou a sobra dessas grandezas? Algo como 1 ano, 2 dias e 3 horas?

a sobra em horas...
A segunda opcao

Esta expressão esta me dando o total em dias... preciso em Ano, Dias e horas restante
Como alterar nessa funcao

Public Function DifData()
Dim TheDate As Date ' Declare variables.
Dim Msg
TheDate = Me.Data_da_Prisão
Msg = MsgBox("Dias de Prisão: " & DateDiff("d", TheDate, Now), vbInformation, "Syspen")
End Function

Uso Esta:

Código:

Public Function Diff2Dates(Interval As String, Date1 As Date, Date2 As Date, Optional ShowZero As Boolean = False) As Variant
' Autor:    ©Copyright 2001 Pacific Database Pty Limited
'          Graham R Seach MCP MVP [email=gseach@pacificdb.com.au]gseach@pacificdb.com.au[/email]
'          Phone: +61 2 9872 9594  Fax: +61 2 9872 9593
'          (*) Alterações sugeridas por Douglas J. Steele MVP
'
'          Este código pode ser usado e distribuído com qualquer aplicativo desenvolvido usando-o com a condição
'  de que este aviso de copyright permaneça sem modificações e intacto como parte do código. Este código
'  não pode ser vendido ou publicado sem autorização expressa do dono do copyright.
'
'Descrição: Esta função calcula o número de anos, meses, dias, horas, minutos e segundos entre duas datas,
'  como tempo decorrido.
'
'Entradas:  Interval:  Intervalos a serem mostrados (uma string)
'      Date1:      A data menor (veja abaixo)
'      Data2:      A data maior (veja abaixo)
'      ShowZero:  Booleano para selecionar se mostra os elementos com valor zero
'
'Saídas:        On error:  Null
'      Sem erros:  Variant contendo o número de anos, meses, dias, horas, minutos e segundos
'              entre as datas, dependendo do intervalo selecionado
'      Se Date1 for maior que Date2, o resultado será um número negativo
'      A função compensa pela falta de qualquer intervalo não listado. Por exemplo, se o intervalo
'      lista "m", mas não "y", a função adiciona o valor do componente ano ao componente mes.
'      Se ShowZero for True e um elemento de saída for zero, ele será mostrado; se ShowZero é False ou
'      omitido, os elementos zerados não são mostrados.
'
'      Por exemplo, com ShowZero = False, Intervalo="ym". elementos = 0 e 1 respectivamente, a
'      string de saída será "1 mês" e não "0 anos 1 mês"
'
'  Alterações adicionais
'      Formatos associados com segmentos de datas
'      Alteração na ordem dos argumentos
  ' Additional changes:
On Error GoTo Err
   
Dim varTemp As Variant, baseDate As Date
Dim diffY As Long, diffM As Long, diffD As Long
Dim diffH As Long, diffN As Long, diffS As Long
Dim y As Boolean, m As Boolean, d As Boolean
Dim h As Boolean, n As Boolean, s As Boolean
Dim ctr As Integer, tmpDate As Date, swapped As Boolean
 
'***********************************************
'Change the following constants according to the
'desired output language
Const Yvar = " ano": Const Yvars = " anos"
Const Mvar = " mês": Const Mvars = " meses"
Const Dvar = " dia": Const Dvars = " dias"
Const Hvar = " hora": Const Hvars = " horas"
Const Nvar = " minuto": Const Nvars = " minutos"
Const Svar = " segundo": Const Svars = " segundos"
   
Const INTERVALS As String = "dmyhns"
'Verifica se Interval contém caracteres válidos
  For ctr = 1 To Len(Interval)
      If InStr(1, INTERVALS, Mid(Interval, ctr, 1)) = 0 Then
          Exit Function
      End If
  Next ctr
   
'Verifica se as datas são válidas
  If Not (IsDate(Date1)) Then Exit Function
  If Not (IsDate(Date2)) Then Exit Function
   
'Se necessário, troca as datas para assegurar que a Data1 é menor que a Data2
  If Date1 > Date2 Then
      tmpDate = Date1
      Date1 = Date2
      Date2 = tmpDate
      swapped = True
  End If
   
  Diff2Dates = Null
  varTemp = Null
   
'Quais os intervalos fornecidos
  y = (InStr(1, Interval, "y") > 0)
  m = (InStr(1, Interval, "m") > 0)
  d = (InStr(1, Interval, "d") > 0)
  h = (InStr(1, Interval, "h") > 0)
  n = (InStr(1, Interval, "n") > 0)
  s = (InStr(1, Interval, "s") > 0)
   
'Debug.Print "Date1: " & Date1
'Debug.Print "Date2: " & Date2
   
'Obtém as diferenças acumuladas
  If y Then
      diffY = Abs(DateDiff("yyyy", Date1, Date2)) - _
              IIf(Format(Date1, "mmddhhnnss") <= Format(Date2, "mmddhhnnss"), 0, 1) '**
      Date1 = DateAdd("yyyy", diffY, Date1)
  End If
  If m Then
      diffM = Abs(DateDiff("m", Date1, Date2)) - _
              IIf(Format(Date1, "ddhhnnss") <= Format(Date2, "ddhhnnss"), 0, 1) '**
      Date1 = DateAdd("m", diffM, Date1)
  End If
  If d Then
      diffD = Abs(DateDiff("d", Date1, Date2)) - _
              IIf(Format(Date1, "hhnnss") <= Format(Date2, "hhnnss"), 0, 1) '**
      Date1 = DateAdd("d", diffD, Date1)
  End If
  If h Then
      diffH = Abs(DateDiff("h", Date1, Date2)) - _
              IIf(Format(Date1, "nnss") <= Format(Date2, "nnss"), 0, 1) '**
      Date1 = DateAdd("h", diffH, Date1)
  End If
  If n Then
      diffN = Abs(DateDiff("n", Date1, Date2)) - _
              IIf(Format(Date1, "ss") <= Format(Date2, "ss"), 0, 1) '**
      Date1 = DateAdd("n", diffN, Date1)
  End If
  If s Then
      diffS = Abs(DateDiff("s", Date1, Date2))
      Date1 = DateAdd("s", diffS, Date1)
  End If
'Prepara a saida
  If y And (diffY > 0 Or ShowZero) Then
      varTemp = IIf(swapped, IIf(diffY > 0, -diffY, diffY), diffY) & _
                  IIf(diffY <> 1, Yvars, Yvar)
  End If
  If m And (diffM > 0 Or ShowZero) Then
      If m Then
          varTemp = varTemp & IIf(IsNull(varTemp), Null, " ") & _
                      diffM & IIf(diffM <> 1, Mvars, Mvar)
      End If
  End If
  If d And (diffD > 0 Or ShowZero) Then
      If d Then
          varTemp = varTemp & IIf(IsNull(varTemp), Null, " ") & _
                      diffD & IIf(diffD <> 1, Dvars, Dvar)
      End If
  End If
  If h And (diffH > 0 Or ShowZero) Then
      If h Then
          varTemp = varTemp & IIf(IsNull(varTemp), Null, " ") & _
                      diffH & IIf(diffH <> 1, Hvars, Hvar)
      End If
  End If
  If n And (diffN > 0 Or ShowZero) Then
      If n Then
          varTemp = varTemp & IIf(IsNull(varTemp), Null, " ") & _
                      diffN & IIf(diffN <> 1, Nvars, Nvar)
      End If
  End If
  If s And (diffS > 0 Or ShowZero) Then
      If s Then
          varTemp = varTemp & IIf(IsNull(varTemp), Null, " ") & _
                      diffS & IIf(diffS <> 1, Svars, Svar)
      End If
  End If
 
  Diff2Dates = Trim(varTemp)
  Exit Function
Err:
  Diff2Dates = Null
End Function


Caro osmar..
Como disse A data inicial é fixa.. uma data inserida na tabela..
No entanto a data final e sempre a data do sistema..
nao a tenho em tabela...

Como aplicar este codigo para me retornar a diferenca entre a data da tabela e a data do sistema e colocar essa diferenca em um campo não acoplado no form?

Grato

Tente substituir aonde vai a Data2 por Date.

Ok.. vou deixar este topico parado por algumas horas.. estou a terminar outra parte..logo retorno por aqui
Grato

Bem Amigos nao estou a usar este topico por hora.. deixarei resolvido e precisando eu o reabro

Saudações