[Resolvido]Função VBA em consulta

Boa tarde à todos!

Criei uma consulta que preciso que me retorne diversas informações como: Meta, PrazoDecorrido, StatusAtual... Para estes três campos serem corretamente calculados, eles dependem de muitas informações que se originam em 9 tabelas. De cada tabela, os campos usam até 6 campos do tipo data.

Para PrazoDecorrido e Meta por exemplo, uso as funções SeImed(), DifData() e Nz() para conseguir chegar ao resultado final, contudo a função diretamente digita em uma célula da consulta fica demasiadamente grande. Ultrapassa os 1048 caracteres, e é esse o seu limite.

A saída então, imagino eu, seria criar uma função em VB para fazer estes cálculos. Mas a minha ideia inicial era criar uma tabela para receber todas as informações que preciso, e a medida que o procedimento fosse preenchendo as informações na tabela, ele também calcularia os resultados dos campos que preciso.

Mas aí me veio a segunda ideia, será que não seria possível colocar o meu procedimento direto na consulta para realizar os cálculos sem que eu tenha que criar procedimentos de inserir e atualizar registros de uma tabela para esta finalidade?

Alguém sabe de alguma coisa?

Aguardo.

Olá Júlio,

Dá pra fazer na consulta.

Por exemplo:

Prazo Decorrido(em meses):
=DifData("m";"DataInicial";"DataFinal")


Status Atual:

=SeImed(Seucritério;"Presente";"Ausente")


etc

Olá meu caro!

Obrigado pelo retorno, contudo, não era essa a minha dúvida. As funções SeImed e DifData eu sei como usar. O problema era que eu precisava criar diversas funções SeImed dentro de uma mesma célula para poder fazer os cálculos que eu precisava, e acabava ultrapassando o limite de caracteres que o campo delimita.

Veja o exemplo abaixo:



Então a minha solução foi criar uma função em VBA para incluir na consulta e eu não estava conseguindo. Só que, após esfriar a cabeça (essa dica é boa: esfriar a cabeça! hehehe), eu conseguir fazer a função funcionar na consulta. Ficou assim:

Primeiro crio a função para realizar o procedimento que preciso (função ainda em desenvolvimento)

Código:

Function sbAlerta(dt1, dt2, dt3, dt4, dt5, dt6, dt7, dt8 As String) As Long

'FUNÇÃO EM DESENVOLVIMENTO

Dim Prz%, idObj%, strFase$, Meta%, strReq$, strCns$, blCIElab, blCIFinal, blCIVerificacao
    
If dt2 <> "" And dt4 <> "" Then
    If dt2 > dt4 Then
        'MsgBox "Teste recebimento Assinatura Interna", vbInformation
        Prz = DateDiff("d", dt2, Date)
        Meta = 2
        Else
            'MsgBox "Teste recebimento Assinatura Externa", vbInformation
            Prz = DateDiff("d", dt4, Date)
            Meta = 2
    End If
    strFase = "FINALIZAÇÃO DO PROCESSO"
    ElseIf dt2 = "" And dt4 <> "" Then
        If dt1 <> "" Then
            'Se a data de recebimento da assinatura interna for nula e a data de envio não for,
            'então calcula-se com a data de envio para a assinatura interna e o Status será ASSINATURA INTERNA
            'MsgBox "Teste envio Assinatura Interna", vbInformation
            Prz = DateDiff("d", dt1, Date)
            strFase = "AGUARDANDO RETORNO DA ASSINATURA INTERNA"
            Meta = 10
            ElseIf dt1 = "" Then
                'Se as datas de assinaturas internas estão nulas, então calcula-se com a data de
                'recebimento da assinatura externa e o Status será ASSINATURA INTERNA
                'MsgBox "Teste recebimento Assinatura Externa", vbInformation
                Prz = DateDiff("d", dt4, Date)
                strFase = "AGUARDANDO ENVIO PARA ASSINATURA INTERNA"
                Meta = 10
        End If
        ElseIf dt2 <> "" And dt4 = "" Then
            If dt3 <> "" Then
                'MsgBox "Teste envio Assinatura Externa", vbInformation
                Prz = DateDiff("d", dt2, Date)
                strFase = "AGUARDANDO RETORNO DA ASSINATURA EXTERNA"
                Meta = 10
                ElseIf dt3 = "" Then
                    'MsgBox "Teste recebimento Assinatura Interna", vbInformation
                    Prz = DateDiff("d", dt2, Date)
                    strFase = "AGUARDANDO ENVIO PARA ASSINATURA EXTERNA"
                    Meta = 10
            End If
            ElseIf IsNull(dt2) And IsNull(dt4) Then
                If dt1 > dt3 And dt3 = "" Then
                    'MsgBox "Teste envio Assinatura Interna", vbInformation
                    Prz = DateDiff("d", dt1, Date)
                    strFase = "AGUARDANDO RETORNO DA ASSINATURA INTERNA"
                    Meta = 10
                    ElseIf dt3 > Nz(dt1, 0) And IsNull(dt1) Then
                        'MsgBox "Teste envio Assinatura Externa", vbInformation
                        Prz = DateDiff("d", dt3, Date)
                        strFase = "AGUARDANDO RETORNO DA ASSINATURA EXTERNA"
                        Meta = 10
                        ElseIf dt1 = "" And dt3 = "" Then
                            If dt5 <> "" Then
                                'MsgBox "Teste Data de Entrega ao contratador", vbInformation
                                Prz = DateDiff("d", dt5, Date)
                                'Meta = Pesquisar
                                If dt9 = "" Then
                                    strFase = "ELABORAÇÃO DE DOCUMENTAÇÃO"
                                    ElseIf dt9 <> "" Then
                                        strFase = "ELABORAÇÃO DE DOCUMENTAÇÃO - TERMO ADITIVO"
                                End If
                                ElseIf dt6 <> "" Then
                                    'MsgBox "Teste Data Liberação Distribuição", vbInformation
                                    Prz = DateDiff("d", dt6, Date)
                                    strFase = "AGUARDANDO DISTRIBUIÇÃO PARA O CONTRATADOR"
                                    'Meta = Pesquisar
                                    ElseIf dt7 <> "" Then
                                        'MsgBox "Teste Data Envio Triagem", vbInformation
                                        Prz = DateDiff("d", dt7, Date)
                                        strFase = "ENVIADO PARA A DISTRIBUIÇÃO"
                                        'Meta = Pesquisar
                                        ElseIf dt8 <> "" Then
                                            'MsgBox "Teste Data Entrada Memorando", vbInformation
                                            Prz = DateDiff("d", dt8, Date)
                                            strFase = "CADASTRO MEMORANDO EM PROGRESSO"
                                            'Meta = Pesquisar
                            End If
                End If
End If

sbAlerta = Prz

End Function

Depois informo na célula a função e seus argumentos:


E por fim o resultado que eu queria:


Era isso. Mas consegui resolver.

Abraços e obrigado.

Lembre-se de marcar o Resolvido

Feito. Abraços.