Senhores,
Vi alguns posts sobre o assunto mas nenhum me ajudou a resolver meu problema.
Tenho um BD que calcula a partir de uma determinada data, 5 dias úteis e me dá o resultado - qual é a data 5 dias úteis depois, descontados finais de semanas e feriados fixos e móveis.
Depois de muito batalhar, consegui um código VB de um banco de dados feito, possivelmente em Access 97.
Utilizei o código, que deu super certo com o que eu precisava, até que tive necessidade de dividir o banco de dados para trabalhar em rede.
Quando executo o código surge a mensagem "Operação Inválida".
Pesquisei bastante. Vi dúvidas de outras pessoas que tinham o mesmo problema que eu, mas não consegui resolver.
Já mudei as referências no VB, já verifiquei os relacionamentos entre as tabelas, já compactei e reparei o BD, já converti para Access 2003, para Access 2007, e nada.
Preciso que alguém analise o código e veja o que está errado para rodar em Access 2007 e o que é necessário alterar.
Aí vai:
Private Sub Comando268_Click()
Dim DataIni As Date, lngPrazo As Long, intUnid As Integer
Dim Resposta As Integer
DataIni = CDate([Data_de_chegada_real])
lngPrazo = CLng([txtNúmero])
intUnid = mldUnidade
' Rotina principal: dispara o cálculo e exibe o resultado
' Se não há o número a somar, sai
If IsNull([txtNúmero]) Or txtNúmero = "" Then Exit Sub
' Se prazo (lngPrazo) > 200 dias e a opção Só Dias Úteis está ligada,
' dá ao usuário a possibilidade de desistir (200 é arbitrário)
If [chkSoDiasÚteis] = True And Abs(lngPrazo) > 200 Then
Resposta = MsgBox("Este cálculo demora mais do que o normal. Deseja continuar?", vbYesNo, "Somente Dias Úteis")
If Resposta <> vbYes Then
Exit Sub
End If
End If
DoCmd.Hourglass True 'Ampulheta: liga
' Apresenta o resultado
[txtDataFinal] = CalculaPrazo(DataIni, lngPrazo, intUnid)
If [chkSoDiasÚteis] = True Then GoTo Fim
' Indica que houve ajuste de Sab/Dom ou Feriado (*)
If [chkFinalDiaÚtil] = True Then
If blnDiaEspecial Then
[txtDiaDaSemana] = [txtDiaDaSemana] & " *"
End If
End If
Fim:
blnDiaEspecial = False
DoCmd.Hourglass False 'Ampulheta: desliga
DoCmd.RunCommand acCmdRefresh
txtDataFinal.Requery
txtDiaDaSemana.Requery
End Sub
Private Function CalculaPrazo(DataIni As Date, lngPrazo As Long, intUnidade As Integer) As String
' Calcula a data final e ajusta-a para o próximo
' dia útil, se o usuário tiver ligado essa opção
On Error GoTo CalculaPrazo_Fim
Dim funcTmp As Date ' valor temporário da função
Dim sIntervalo As String ' tipo de prazo a somar: dia, semana, mês
Dim intDiaSemana As Integer ' índice do dia da semana: 1, 2, 3...
Dim lngContador As Long ' conta sábs/doms e feriados
Dim n As Integer ' 1, ou -1, cf. o sinal de lngPrazo
Dim Resposta As Integer ' resposta da msgbox
Dim blnDataIniAjustada As Boolean
n = IIf(lngPrazo <= 0, -1, 1)
Select Case intUnidade
Case 1 'Dia
sIntervalo = "d"
Case 2 'Semana
sIntervalo = "ww"
Case Else 'Mês
sIntervalo = "m"
End Select
' Calcula para a opção Somente Dias Úteis
If [chkSoDiasÚteis] = True Then
lngPrazo = Abs(lngPrazo)
lngContador = 0
If WeekDay(DataIni) = 7 Or WeekDay(DataIni) = 1 Or E_DiaEspecial(DataIni) Then
lngPrazo = lngPrazo - 1
End If
funcTmp = DataIni
While lngContador < lngPrazo
If Not E_DiaEspecial(funcTmp) Then
lngContador = lngContador + 1
End If
'funcTmp = DateAdd("d", n, funcTmp)
funcTmp = funcTmp + n
Wend
GoTo Verifica_Final
End If
' Ajusta DataIni se o dia inicial não é útil
' Sexta-feira & +: começa contagem na segunda
' Segunda-feira e -: começa contagem na sexta
If [chkFinalDiaÚtil] = True Then
If (WeekDay(DataIni) = 6 And n > 0) Or (WeekDay(DataIni) = 2 And n < 0) Then
DataIni = DataIni + 2 * n
Else
While E_DiaEspecial(DataIni)
DataIni = DataIni + n
blnDataIniAjustada = True
Wend
End If
'---------------- versão 1.1 ------------------
' Checa de novo se DataIni cai em dia especial
While E_DiaEspecial(DataIni)
DataIni = DataIni + n
Wend
'---------------------------------------------
End If
'1. Calcula a primeira data: dataIni + n Unidades
funcTmp = DateAdd(sIntervalo, lngPrazo, DataIni)
Verifica_Final:
'2. Verifica se é sáb, dom ou feriado e soma (ou subtrai) 1
If [chkFinalDiaÚtil] = True Then
While E_DiaEspecial(funcTmp)
'funcTmp = DateAdd("d", n, funcTmp)
funcTmp = funcTmp + n
blnDiaEspecial = True
Wend
End If
' Valor final da função
CalculaPrazo = Format$(funcTmp, "dd/mm/yyyy")
CalculaPrazo_Fim:
DoCmd.Hourglass False
Exit Function
CalculaPrazo_Err:
MsgBox Err.Description
Resume CalculaPrazo_Fim
End Function
Agradeço desde já.
Roberto Brito
Vi alguns posts sobre o assunto mas nenhum me ajudou a resolver meu problema.
Tenho um BD que calcula a partir de uma determinada data, 5 dias úteis e me dá o resultado - qual é a data 5 dias úteis depois, descontados finais de semanas e feriados fixos e móveis.
Depois de muito batalhar, consegui um código VB de um banco de dados feito, possivelmente em Access 97.
Utilizei o código, que deu super certo com o que eu precisava, até que tive necessidade de dividir o banco de dados para trabalhar em rede.
Quando executo o código surge a mensagem "Operação Inválida".
Pesquisei bastante. Vi dúvidas de outras pessoas que tinham o mesmo problema que eu, mas não consegui resolver.
Já mudei as referências no VB, já verifiquei os relacionamentos entre as tabelas, já compactei e reparei o BD, já converti para Access 2003, para Access 2007, e nada.
Preciso que alguém analise o código e veja o que está errado para rodar em Access 2007 e o que é necessário alterar.
Aí vai:
Private Sub Comando268_Click()
Dim DataIni As Date, lngPrazo As Long, intUnid As Integer
Dim Resposta As Integer
DataIni = CDate([Data_de_chegada_real])
lngPrazo = CLng([txtNúmero])
intUnid = mldUnidade
' Rotina principal: dispara o cálculo e exibe o resultado
' Se não há o número a somar, sai
If IsNull([txtNúmero]) Or txtNúmero = "" Then Exit Sub
' Se prazo (lngPrazo) > 200 dias e a opção Só Dias Úteis está ligada,
' dá ao usuário a possibilidade de desistir (200 é arbitrário)
If [chkSoDiasÚteis] = True And Abs(lngPrazo) > 200 Then
Resposta = MsgBox("Este cálculo demora mais do que o normal. Deseja continuar?", vbYesNo, "Somente Dias Úteis")
If Resposta <> vbYes Then
Exit Sub
End If
End If
DoCmd.Hourglass True 'Ampulheta: liga
' Apresenta o resultado
[txtDataFinal] = CalculaPrazo(DataIni, lngPrazo, intUnid)
If [chkSoDiasÚteis] = True Then GoTo Fim
' Indica que houve ajuste de Sab/Dom ou Feriado (*)
If [chkFinalDiaÚtil] = True Then
If blnDiaEspecial Then
[txtDiaDaSemana] = [txtDiaDaSemana] & " *"
End If
End If
Fim:
blnDiaEspecial = False
DoCmd.Hourglass False 'Ampulheta: desliga
DoCmd.RunCommand acCmdRefresh
txtDataFinal.Requery
txtDiaDaSemana.Requery
End Sub
Private Function CalculaPrazo(DataIni As Date, lngPrazo As Long, intUnidade As Integer) As String
' Calcula a data final e ajusta-a para o próximo
' dia útil, se o usuário tiver ligado essa opção
On Error GoTo CalculaPrazo_Fim
Dim funcTmp As Date ' valor temporário da função
Dim sIntervalo As String ' tipo de prazo a somar: dia, semana, mês
Dim intDiaSemana As Integer ' índice do dia da semana: 1, 2, 3...
Dim lngContador As Long ' conta sábs/doms e feriados
Dim n As Integer ' 1, ou -1, cf. o sinal de lngPrazo
Dim Resposta As Integer ' resposta da msgbox
Dim blnDataIniAjustada As Boolean
n = IIf(lngPrazo <= 0, -1, 1)
Select Case intUnidade
Case 1 'Dia
sIntervalo = "d"
Case 2 'Semana
sIntervalo = "ww"
Case Else 'Mês
sIntervalo = "m"
End Select
' Calcula para a opção Somente Dias Úteis
If [chkSoDiasÚteis] = True Then
lngPrazo = Abs(lngPrazo)
lngContador = 0
If WeekDay(DataIni) = 7 Or WeekDay(DataIni) = 1 Or E_DiaEspecial(DataIni) Then
lngPrazo = lngPrazo - 1
End If
funcTmp = DataIni
While lngContador < lngPrazo
If Not E_DiaEspecial(funcTmp) Then
lngContador = lngContador + 1
End If
'funcTmp = DateAdd("d", n, funcTmp)
funcTmp = funcTmp + n
Wend
GoTo Verifica_Final
End If
' Ajusta DataIni se o dia inicial não é útil
' Sexta-feira & +: começa contagem na segunda
' Segunda-feira e -: começa contagem na sexta
If [chkFinalDiaÚtil] = True Then
If (WeekDay(DataIni) = 6 And n > 0) Or (WeekDay(DataIni) = 2 And n < 0) Then
DataIni = DataIni + 2 * n
Else
While E_DiaEspecial(DataIni)
DataIni = DataIni + n
blnDataIniAjustada = True
Wend
End If
'---------------- versão 1.1 ------------------
' Checa de novo se DataIni cai em dia especial
While E_DiaEspecial(DataIni)
DataIni = DataIni + n
Wend
'---------------------------------------------
End If
'1. Calcula a primeira data: dataIni + n Unidades
funcTmp = DateAdd(sIntervalo, lngPrazo, DataIni)
Verifica_Final:
'2. Verifica se é sáb, dom ou feriado e soma (ou subtrai) 1
If [chkFinalDiaÚtil] = True Then
While E_DiaEspecial(funcTmp)
'funcTmp = DateAdd("d", n, funcTmp)
funcTmp = funcTmp + n
blnDiaEspecial = True
Wend
End If
' Valor final da função
CalculaPrazo = Format$(funcTmp, "dd/mm/yyyy")
CalculaPrazo_Fim:
DoCmd.Hourglass False
Exit Function
CalculaPrazo_Err:
MsgBox Err.Description
Resume CalculaPrazo_Fim
End Function
Agradeço desde já.
Roberto Brito