Ciao Alex,
nei giorni scorsi ho fatto diverse prove compresa quella che mi hai suggerito:
Ho creato una query di selezione e lanciata da li la funzione GetWorkDaysNum scritta in questo modo:
Giorni: GetWorkDaysNum([Data Inzio];[Data Fine prevista];6)
la query è questa:
SELECT [10 Commesse].[Nome progetto], [10 Commesse].ODV, [20 Macchine].PosizioneODV, [20 Macchine].[Macchina in Fornitura], [20 Macchine].Modello, [20 Macchine].ID, [30 Attivita macchine].[N° Operazione], [30 Attivita macchine].Attività, [30 Attivita macchine].[Data Inzio], [30 Attivita macchine].[Data Fine prevista], [30 Attivita macchine].[Ore previste], [10 Commesse].Stato, [30 Attivita macchine].Codice_Somma, Colori_Ore.Priorita, GetWorkDaysNum([Data Inzio],[Data Fine prevista],6) AS Giorni
FROM [10 Commesse] LEFT JOIN ([20 Macchine] LEFT JOIN ([30 Attivita macchine] LEFT JOIN Colori_Ore ON [30 Attivita macchine].Codice_Somma = Colori_Ore.Desc_Attivita) ON [20 Macchine].ID = [30 Attivita macchine].Id_macchina_riferimento) ON [10 Commesse].ID = [20 Macchine].Progetto
WHERE ((([30 Attivita macchine].[Data Inzio]) Is Not Null) AND (([10 Commesse].Stato)="In corso") AND (([30 Attivita macchine].Codice_Somma) Is Not Null) AND ((Colori_Ore.Priorita) Is Not Null))
ORDER BY Colori_Ore.Priorita;
il codice che richiama è questo:
Public Function GetWorkDaysNum(DateStart As Date, DateStop As Date, Optional WorkDays As Integer = 6) As Long
Dim dtStart As Date
Dim dtStop As Date
Dim dtAct As Date
Dim lngTot As Long
Dim lngTotW As Long
Dim x As Long
Dim blFest As Boolean
Dim conta
dtStart = DateStart
dtStop = DateStop
dtAct = DateStart
lngTot = DateDiff("d", dtStart, dtStop) + 1
Do Until dtAct > dtStop
blFest = False
' Controllo se il G è all'interno della Settimana LUNGA/CORTA
' quindi se è SABATO o DOMENICA.
If Weekday(dtAct, vbMonday) > WorkDays Then blFest = True
' Nel caso non sia già SABATO/DOMENICA controllo che non sia
' una FESTIVITA'.
If blFest = False Then blFest = Festivo2(dtAct)
x = x - blFest
dtAct = DateAdd("d", 1, dtAct)
Loop
lngTotW = lngTot - x
GetWorkDaysNum = lngTotW
End Function
Function Festivo2(ByVal mydate As Date, Optional domenica As Boolean = True, Optional sabato As Boolean = False) As Boolean
Dim Festivo
If sabato = True Then
Festivo = Weekday(mydate, vbMonday) = 6
If Festivo Then: Exit Function
End If
If domenica = True Then
Festivo = Weekday(mydate, vbMonday) = 7
If Festivo Then: Exit Function
End If
Festivo = (Easter(year(mydate)) = mydate)
If Festivo Then Exit Function
Festivo = (Easter(year(mydate)) + 1 = mydate)
If Festivo Then Exit Function
' Controllo le Festività RICORRENTI
Dim rs As DAO.Recordset
Dim sSQL As String
sSQL = "SELECT * FROM T_FL WHERE Giorno=" & Day(mydate) & " AND Mese=" & Month(mydate) & " AND Attivo=-1"
Set rs = DBEngine(0)(0).OpenRecordset(sSQL, dbOpenDynaset, dbReadOnly)
' Se il rs è vuoto significa che la data non è inserita come FESTIVITA'
If rs.EOF = False Then Festivo = True
rs.Close
Set rs = Nothing
If Festivo Then Exit Function
' Controllo le Festività ONE-SHOT
sSQL = "SELECT * FROM T_FL WHERE Giorno=" & Day(mydate) & " AND Mese=" & Month(mydate) & " AND Anno=" & year(mydate) & " AND Attivo=-1"
Set rs = DBEngine(0)(0).OpenRecordset(sSQL, dbOpenDynaset, dbReadOnly)
' Se il rs è vuoto significa che la data non è inserita come FESTIVITA'
If rs.EOF = False Then Festivo = True
rs.Close
Set rs = Nothing
End Function
' CALCOLO DELLA PASQUA
' Questa funzione non è mia ma è recuperata dal WEB
Public Function Easter(year As Integer) As Date
Dim d As Integer
d = (((255 - 11 * (year Mod 19)) - 21) Mod 30) + 21
Easter = DateSerial(year, 3, 1) + d + (d > 48) + 6 - ((year + year \ 4 + d + (d > 48) + 1) Mod 7)
End Function
lanciandolo cosi funziona ma la query diventa lentissima anche in visualizzazione, se la scorri "rallenta" come se ricalcolasse qualcosa inoltre cliccando sulle varie celle ha dei ritardi a selezionarle nell'ordine del mezzo secondo.
Infine dal 13/05/16 al 21/06/16 la formula mi calcola 34 giorni, non dovrebbero essere 33?
Richiamo bene la funzione? ho fatto qualche casino copiando il codice? onestamente non so piu cosa provare, c'è un qualche errore stupido che non vedo?
Edit: avevo provato anche una query piu semplice, stesso problema di rallentamento