[Resolvido]Função de Data na Consulta

Bom dia,

TEnho uma consulta SQL abaixo:

SELECT TabAluno.Nome, TabAluno.Nome_Responsável, TabAluno.Cidade, TabAluno.Estado, TabAluno.Entrada_001, TabAluno.Saída_001, AnoMesDia([Nascimento]) AS Idade, Perm([Entrada_001],[Saída_001]) AS Permanência FROM TabAluno

Com a funçao AnoMesDia que calcula a idade e tempo de permanencia, só qu para permanencia está havendo um erro interceptável, que caso o aluno tenha já se retirado da instituição, ele tenha uma data de saída anterior a hoje, pois existe este campo na tabaluno, fiz uma mudança na função e dei o nome de (perm) e tá dando um erro:

AnoMesDia

Public Function AnoMesDia(dtData1 As Date) As String
On Error GoTo AnoMesDia_Err

Dim sTmp As String
Dim nDMA As Long
Dim NewDate As Date
Dim sSngPlural As String
Dim dtData2 As Date


dtData2 = Now

' Bloco Ano ---------------------
' Calcula número inteiro de anos
nDMA = DateDiff("yyyy", dtData1, dtData2)
' Se Data1+nDMA>Data2, subtrai 1 ano
If DateAdd("yyyy", nDMA, dtData1) > dtData2 Then
nDMA = nDMA - 1
End If
sSngPlural = " ano, "
If nDMA > 1 Then sSngPlural = " anos, "
sTmp = nDMA & sSngPlural

' Bloco Mês ---------------------
' Nova data de referência
NewDate = DateAdd("yyyy", nDMA, dtData1)
nDMA = DateDiff("m", NewDate, dtData2)
' Se Data1+nDMA>Data2, subtrai 1 mês
If DateAdd("m", nDMA, NewDate) > dtData2 Then
nDMA = nDMA - 1
End If
sSngPlural = " mês e "
If nDMA > 1 Then sSngPlural = " meses e "
sTmp = sTmp & nDMA & sSngPlural

' Bloco Dia ---------------------
NewDate = DateAdd("m", nDMA, NewDate)
nDMA = DateDiff("d", NewDate, dtData2)
sSngPlural = " dia"
If nDMA > 1 Then sSngPlural = " dias"
sTmp = sTmp & nDMA & sSngPlural

' Valor final da função
AnoMesDia = sTmp

AnoMesDia_Fim:
Exit Function
AnoMesDia_Err:
MsgBox Err.Description
Resume AnoMesDia_Fim
End Function


função perm


Public Function Perm(dtData1 As Date, dtData2 As Date) As String
On Error GoTo AnoMesDia_Err

Dim sTmp As String
Dim nDMA As Long
Dim NewDate As Date
Dim sSngPlural As String
Dim dtData2 As Date


'dtData2 = Now

' Bloco Ano ---------------------
' Calcula número inteiro de anos
nDMA = DateDiff("yyyy", dtData1, dtData2)
' Se Data1+nDMA>Data2, subtrai 1 ano
If DateAdd("yyyy", nDMA, dtData1) > dtData2 Then
nDMA = nDMA - 1
End If
sSngPlural = " ano, "
If nDMA > 1 Then sSngPlural = " anos, "
sTmp = nDMA & sSngPlural

' Bloco Mês ---------------------
' Nova data de referência
NewDate = DateAdd("yyyy", nDMA, dtData1)
nDMA = DateDiff("m", NewDate, dtData2)
' Se Data1+nDMA>Data2, subtrai 1 mês
If DateAdd("m", nDMA, NewDate) > dtData2 Then
nDMA = nDMA - 1
End If
sSngPlural = " mês e "
If nDMA > 1 Then sSngPlural = " meses e "
sTmp = sTmp & nDMA & sSngPlural

' Bloco Dia ---------------------
NewDate = DateAdd("m", nDMA, NewDate)
nDMA = DateDiff("d", NewDate, dtData2)
sSngPlural = " dia"
If nDMA > 1 Then sSngPlural = " dias"
sTmp = sTmp & nDMA & sSngPlural

' Valor final da função
AnoMesDia = sTmp

AnoMesDia_Fim:
Exit Function
AnoMesDia_Err:
MsgBox Err.Description
Resume AnoMesDia_Fim
End Function


Quando executo dá o seguinte erro:

Funçao 'Perm' indefinada na expressão

O que faço?

Atenciosamente,

Adilson Calixto

Retire o que está vermelho e teste por favor.


SELECT TabAluno.Nome, TabAluno.Nome_Responsável, TabAluno.Cidade, TabAluno.Estado, TabAluno.Entrada_001, TabAluno.Saída_001, AnoMesDia([Nascimento]) AS Idade, Perm([Entrada_001],[Saída_001]) AS Permanência FROM TabAluno

Com a funçao AnoMesDia que calcula a idade e tempo de permanencia, só qu para permanencia está havendo um erro interceptável, que caso o aluno tenha já se retirado da instituição, ele tenha uma data de saída anterior a hoje, pois existe este campo na tabaluno, fiz uma mudança na função e dei o nome de (perm) e tá dando um erro:

AnoMesDia

Public Function AnoMesDia(dtData1 As Date) As String
On Error GoTo AnoMesDia_Err

Dim sTmp As String
Dim nDMA As Long
Dim NewDate As Date
Dim sSngPlural As String
Dim dtData2 As Date


dtData2 = Now

' Bloco Ano ---------------------
' Calcula número inteiro de anos
nDMA = DateDiff("yyyy", dtData1, dtData2)
' Se Data1+nDMA>Data2, subtrai 1 ano
If DateAdd("yyyy", nDMA, dtData1) > dtData2 Then
nDMA = nDMA - 1
End If
sSngPlural = " ano, "
If nDMA > 1 Then sSngPlural = " anos, "
sTmp = nDMA & sSngPlural

' Bloco Mês ---------------------
' Nova data de referência
NewDate = DateAdd("yyyy", nDMA, dtData1)
nDMA = DateDiff("m", NewDate, dtData2)
' Se Data1+nDMA>Data2, subtrai 1 mês
If DateAdd("m", nDMA, NewDate) > dtData2 Then
nDMA = nDMA - 1
End If
sSngPlural = " mês e "
If nDMA > 1 Then sSngPlural = " meses e "
sTmp = sTmp & nDMA & sSngPlural

' Bloco Dia ---------------------
NewDate = DateAdd("m", nDMA, NewDate)
nDMA = DateDiff("d", NewDate, dtData2)
sSngPlural = " dia"
If nDMA > 1 Then sSngPlural = " dias"
sTmp = sTmp & nDMA & sSngPlural

' Valor final da função
AnoMesDia = sTmp

AnoMesDia_Fim:
Exit Function
AnoMesDia_Err:
MsgBox Err.Description
Resume AnoMesDia_Fim
End Function


função perm 'Isso está causando o erro. Retire e teste


Public Function Perm(dtData1 As Date, dtData2 As Date) As String
On Error GoTo AnoMesDia_Err

Dim sTmp As String
Dim nDMA As Long
Dim NewDate As Date
Dim sSngPlural As String
Dim dtData2 As Date


'dtData2 = Now

' Bloco Ano ---------------------
' Calcula número inteiro de anos
nDMA = DateDiff("yyyy", dtData1, dtData2)
' Se Data1+nDMA>Data2, subtrai 1 ano
If DateAdd("yyyy", nDMA, dtData1) > dtData2 Then
nDMA = nDMA - 1
End If
sSngPlural = " ano, "
If nDMA > 1 Then sSngPlural = " anos, "
sTmp = nDMA & sSngPlural

' Bloco Mês ---------------------
' Nova data de referência
NewDate = DateAdd("yyyy", nDMA, dtData1)
nDMA = DateDiff("m", NewDate, dtData2)
' Se Data1+nDMA>Data2, subtrai 1 mês
If DateAdd("m", nDMA, NewDate) > dtData2 Then
nDMA = nDMA - 1
End If
sSngPlural = " mês e "
If nDMA > 1 Then sSngPlural = " meses e "
sTmp = sTmp & nDMA & sSngPlural

' Bloco Dia ---------------------
NewDate = DateAdd("m", nDMA, NewDate)
nDMA = DateDiff("d", NewDate, dtData2)
sSngPlural = " dia"
If nDMA > 1 Then sSngPlural = " dias"
sTmp = sTmp & nDMA & sSngPlural

' Valor final da função
AnoMesDia = sTmp

AnoMesDia_Fim:
Exit Function
AnoMesDia_Err:
MsgBox Err.Description
Resume AnoMesDia_Fim
End Function

Boa Tarde,

Copiei e Colei e não deu certo, gera o mesmo erro. O que será que estou fazendo de errado?


Adilson

Copie essa:


Public Function AnoMesDia(dtData1 As Date) As String
On Error GoTo AnoMesDia_Err

Dim sTmp As String
Dim nDMA As Long
Dim NewDate As Date
Dim sSngPlural As String
Dim dtData2 As Date


dtData2 = Now

' Bloco Ano ---------------------
' Calcula número inteiro de anos
nDMA = DateDiff("yyyy", dtData1, dtData2)
' Se Data1+nDMA>Data2, subtrai 1 ano
If DateAdd("yyyy", nDMA, dtData1) > dtData2 Then
nDMA = nDMA - 1
End If
sSngPlural = " ano, "
If nDMA > 1 Then sSngPlural = " anos, "
sTmp = nDMA & sSngPlural

' Bloco Mês ---------------------
' Nova data de referência
NewDate = DateAdd("yyyy", nDMA, dtData1)
nDMA = DateDiff("m", NewDate, dtData2)
' Se Data1+nDMA>Data2, subtrai 1 mês
If DateAdd("m", nDMA, NewDate) > dtData2 Then
nDMA = nDMA - 1
End If
sSngPlural = " mês e "
If nDMA > 1 Then sSngPlural = " meses e "
sTmp = sTmp & nDMA & sSngPlural

' Bloco Dia ---------------------
NewDate = DateAdd("m", nDMA, NewDate)
nDMA = DateDiff("d", NewDate, dtData2)
sSngPlural = " dia"
If nDMA > 1 Then sSngPlural = " dias"
sTmp = sTmp & nDMA & sSngPlural

' Valor final da função
AnoMesDia = sTmp

AnoMesDia_Fim:
Exit Function
AnoMesDia_Err:
MsgBox Err.Description
Resume AnoMesDia_Fim
End Function


Public Function Perm(dtData1 As Date, dtData2 As Date) As String
On Error GoTo AnoMesDia_Err

Dim sTmp As String
Dim nDMA As Long
Dim NewDate As Date
Dim sSngPlural As String
Dim dtData2 As Date


'dtData2 = Now

' Bloco Ano ---------------------
' Calcula número inteiro de anos
nDMA = DateDiff("yyyy", dtData1, dtData2)
' Se Data1+nDMA>Data2, subtrai 1 ano
If DateAdd("yyyy", nDMA, dtData1) > dtData2 Then
nDMA = nDMA - 1
End If
sSngPlural = " ano, "
If nDMA > 1 Then sSngPlural = " anos, "
sTmp = nDMA & sSngPlural

' Bloco Mês ---------------------
' Nova data de referência
NewDate = DateAdd("yyyy", nDMA, dtData1)
nDMA = DateDiff("m", NewDate, dtData2)
' Se Data1+nDMA>Data2, subtrai 1 mês
If DateAdd("m", nDMA, NewDate) > dtData2 Then
nDMA = nDMA - 1
End If
sSngPlural = " mês e "
If nDMA > 1 Then sSngPlural = " meses e "
sTmp = sTmp & nDMA & sSngPlural

' Bloco Dia ---------------------
NewDate = DateAdd("m", nDMA, NewDate)
nDMA = DateDiff("d", NewDate, dtData2)
sSngPlural = " dia"
If nDMA > 1 Then sSngPlural = " dias"
sTmp = sTmp & nDMA & sSngPlural

' Valor final da função
AnoMesDia = sTmp

AnoMesDia_Fim:
Exit Function
AnoMesDia_Err:
MsgBox Err.Description
Resume AnoMesDia_Fim
End Function

Rapaz vou lhe agradecer pela a ajuda, mas não estou com cabeça para resolver isso não, nada tá dando certo, o problema é comigo mesmo. acho que vou mudar tudo sei lá. depois vejo isso.


obrigado

adilson

Desistiu rápido amigão... Observe que esta a aplicar uma copia de uma função em um mesmo módulo... as vezes quando temos funções com códigos semelhantes uma pode se confundir com a outra... Tem que fazer isto com calma...

Explique com detalhes o que quer e poste parte do bd..

Saudções

Bom dia, Harysohn.

Não é que desisti rápido se você soubesse como sou perseverante Amigão. Porém ontem eu estava muito mau, pois tem alguns problemas acontencendo dificeis em cima de mim que prejudicam meu desempenho, mas só parei para esfriar a cuca e recomeçar.

O detalhe é o seguinte, aquela função que você me passou (AnoMesDia) coloquei no codigo do form e não no modulo, introduzi ela na consulta SQL, funciona bem, quando eu copie e com outro nome (perm) para calcular o tempo de permanencia do individuo na instituição e coloco na função não funciona mais. Você pode verificar tudo isso no frmConsultaGeral.

E tirei aqueles textos entre aspas de anos, meses e dias, mas não sai fica exibindo no listbox. Mesmo sem está na função. Qual a besteira que estou fazendo agora?

http://dl.dropbox.com/u/37804873/Administrativo%20DEJOSAN.rar

Atenciosamente,

Adilson

Qual o form?

frmConsultaGeral

aqui esta mostrando a idade e permanencia.. qual o problema?

o problema é o seguinte,

a permanência é até a data em que o aluno permaneceu na casa, ou seja até a data de saída e não até a data de hoje, por exemplo se ele saiu a um mes atrás, e usar a função AnoDiaMes vai paracer que ele está ainda na casa pois vai calcular com:

dtData2 = Now

se lembra?

Olhe a função Perm, que mudei isso. E tirei a opção ano, meses e dias da função para não exibir esses textos no calculo, mas insiste em exibir?


Adilson

Vamos la Amigão...

1 - Função em Módulo é em Módulo.... Se está no form é no Form
** Voce esta com a funçao em Módulo e tambem no form... Ambas iguail, como publicas e com as mesmas variáveis.. Isso fatalmente enseja em Erro... Se está em módulo trate-a apenas lá...Portanto exclui as duas funções no Form (AnoMesDia e Perm)
2 - Copiei a função AnoMesDia para Perm, no mesmo Módulo.. Tendo o cuidado de renomerar as variáveis pois se não renomear fatalmente dará duplicação no Escopo... ou seja:

Se na funçao AnoMesDia
Public Function AnoMesDia(dtData1 As Date) As String 'esta variável DtData1 não pode ser utilizada na outra função, assim a outra função:
Public Function Perm(dtDataX As Date, dtDataY As Date) As String
Observe que a função AnoMesDia utiliza apenas uma data variável a ser carregada com o valor constante na tabela, a outra pega a data do sistema, então nesta função substitui a data do sistema (Now) por mais uma variável a buscar a segunda data na tabela tambem

No restante da função cuidei de substituir e alterar as respectivas variáveis..

Código

Código:


Public Function Perm(dtDataX As Date, dtDataY As Date) As String
On Error GoTo Perm_Err

  Dim sTmp As String
  Dim nDMA As Long
  Dim NewDate As Date
  Dim sSngPlural As String
 

 
  ' Bloco Ano ---------------------
  ' Calcula número inteiro de anos
  nDMA = DateDiff("yyyy", dtDataX, dtDataY)
  ' Se Data1+nDMA>Data2, subtrai 1 ano
  If DateAdd("yyyy", nDMA, dtDataX) > dtDataY Then
    nDMA = nDMA - 1
  End If
  sSngPlural = " ano, "
  If nDMA > 1 Then sSngPlural = " anos, "
  sTmp = nDMA & sSngPlural
 
  ' Bloco Mês ---------------------
  ' Nova data de referência
  NewDate = DateAdd("yyyy", nDMA, dtDataX)
  nDMA = DateDiff("m", NewDate, dtDataY)
  ' Se Data1+nDMA>Data2, subtrai 1 mês
  If DateAdd("m", nDMA, NewDate) > dtDataY Then
    nDMA = nDMA - 1
  End If
  sSngPlural = " mês e "
  If nDMA > 1 Then sSngPlural = " meses e "
  sTmp = sTmp & nDMA & sSngPlural
 
  ' Bloco Dia ---------------------
  NewDate = DateAdd("m", nDMA, NewDate)
  nDMA = DateDiff("d", NewDate, dtDataY)
  sSngPlural = " dia"
  If nDMA > 1 Then sSngPlural = " dias"
  sTmp = sTmp & nDMA & sSngPlural
 
  ' Valor final da função
  Perm = sTmp
 
Perm_Fim:
  Exit Function
Perm_Err:
  MsgBox Err.Description
  Resume Perm_Fim
End Function



*** Ja está corrigido apenas na linha de origem (Quando abre o form) e na alteração da caixa texto onde se digita o nome..
Utilize da maneira como está nas demais que pretender.

http://dl.dropbox.com/u/26441349/dyl.Programador_31_08_11.rar

Cumprimentos

Ficou show Amigão. Agora me faltam dois detalhes.

1 - Como posso tirar para não exibir os textos anos, meses, e dias. Só mostrar assim: 0,2,5.

2 - Como faço para se não houver data de saída, ou seja o aluno estiver na casa contar o tempo em que ele permanece na casa, vamos ter que alterar a função perm, como seria feito isso. Pode me ajudar ainda mais nesse assunto?


Agradecido

Adilson

Creio que ná função é nestas linhas e semelhantes:

If nDMA > 1 Then sSngPlural = " dias"
Para
If nDMA > 1 Then sSngPlural = " "

é por ai...

Quando não houver essa informação.. bem tem que testar ai e ver se aparece algum erro...

teste de todas as formas e informe...

Este tópico creio que já finalizamos.. Nova dúvida, novo tópico
Abração

FAlou


brigadooooooooo


adilson

O Fórum agradece o Retorno.. Bom trabalho.