Eaheru
142Messages postés
23 juin 2010Date d'inscription
20 décembre 2011Dernière intervention
6 juil. 2010 à 15:54
Alors, voici ou j'en suis :
La macro est intégrée, elle est bien appelée mais plante en m'indiquant que la date de début n'est pas une date (hors j'ai vérifié le format de la cellule etc, c'est bien une date).
J'ai déclaré les différents paramètres en début de fonction, quelqu'un pourrait il m'indiquer ou es l'erreur svp ?
*** Edit ****
Serait il possible que ce soit dû au fait que la première ligne est constituée des titres ?
Si oui, comment faire en sorte que les calculs de jours ouvrés ne se fassent que sur les lignes remplies ?
Merci d'avance pour votre aide.
voici la macro inserée dans la feuille de travail
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lig As Long
lig = Target.Row
If lig = 1 Then Exit Sub 'non actif sur ligne 1
ActiveSheet.Unprotect Password:="test"
Cells(lig, 12).Locked = Not (Application.CountA(Cells(lig, 1).Resize(1, 8)) = 8)
If Not Intersect(Target, Cells(lig, 2).Resize(1, 7)) Is Nothing Then
If Application.CountA(Cells(lig, 2).Resize(1, 7)) = 7 Then
Cells(lig, 1) = Now()
Else
Cells(lig, 1) = ""
End If
ElseIf Not Intersect(Target, Range("I" & lig)) Is Nothing Then
Cells(lig, 1).Resize(1, 11).Locked = (Cells(lig, 9) <> "")
Cells(lig, 10) = Now()
' Lancement calcul de jours ouvrés
calculJO
End If
ActiveSheet.Protect Password:="test", DrawingObjects:=False, Contents:=True, Scenarios:=False
ActiveSheet.EnableSelection = xlUnlockedCells
End Sub
'sub routine interface pour calcul de jours ouvrés
Sub calculJO()
Dim ligne As Range
Dim no_ligne As Integer
For Each ligne In ActiveSheet.UsedRange.Rows
no_ligne = ligne.Row
'appel de la routine de calcul et passage de parametres + affichage du resultat dans colonne K
Columns("K").Rows(no_ligne) = nb_jours_ouvrés(Columns("E").Rows(no_ligne).Value, Columns("G").Rows(no_ligne).Value)
Next
End Sub
' calcul des jours ouvrés (date_début = Columns("E").Rows(no_ligne).Value) et (date_fin = Columns("G").Rows(no_ligne).Value)
Function nb_jours_ouvrés(date_début, date_fin) As Integer
Dim nb_jours_calendaires As Integer
Dim nb_jours_non_ouvrés As Integer
Dim date_i As Integer
' contrôle dates ------------------------------
If Not IsDate(date_début) Then
MsgBox "la date début n'est pas une date "
Exit Function
End If
If Not IsDate(date_fin) Then
MsgBox "la date fin n'est pas une date "
Exit Function
End If
If date_fin < date_début Then
MsgBox "la date fin n'est pas supérieure à la date début "
Exit Function
End If
' nb jours calendaires ------------------------------
nb_jours_calendaires = date_fin - date_début
' détection jours non ouvrés ------------------------------
nb_jours_non_ouvrés = 0
For date_i = date_début To date_fin
If DatePart("w", date_i, vbMonday) = 6 _
Or DatePart("w", date_i, vbMonday) = 7 _
Or date_i = premier_jour_année(Year(date_i)) _
Or date_i = lundi_Paques(Year(date_i)) _
Or date_i = premier_mai(Year(date_i)) _
Or date_i = huit_mai(Year(date_i)) _
Or date_i = jeudi_Ascension(Year(date_i)) _
Or date_i = lundi_Pentecote(Year(date_i)) _
Or date_i = fête_nationale(Year(date_i)) _
Or date_i = onze_novembre(Year(date_i)) _
Or date_i = noël(Year(date_i)) Then
nb_jours_non_ouvrés = nb_jours_non_ouvrés + 1
End If
Next
'---------------------------------------------------------------
' nb jours ouvrés ------------------------------
nb_jours_ouvrés = nb_jours_calendaires - nb_jours_non_ouvrés
End Function
Function premier_jour_année(année As Integer) As String
premier_jour_année = DateSerial(année, 1, 1)
End Function
Function premier_mai(année As Integer) As String
premier_mai = DateSerial(année, 5, 1)
End Function
Function huit_mai(année As Integer) As String
huit_mai = DateSerial(année, 5, 8)
End Function
Function fête_nationale(année As Integer) As String
fête_nationale = DateSerial(année, 7, 14)
End Function
Function onze_novembre(année As Integer) As String
onze_novembre = DateSerial(année, 11, 11)
End Function
Function noël(année As Integer) As String
noël = DateSerial(année, 12, 25)
End Function
Function lundi_Paques(année As Integer) As String
lundi_Paques = DateAdd("d", 1, date_Paques(année))
End Function
Function jeudi_Ascension(année As Integer) As String
jeudi_Ascension = DateAdd("d", 39, date_Paques(année))
End Function
Function lundi_Pentecote(année As Integer) As String
lundi_Pentecote = DateAdd("d", 50, date_Paques(année))
End Function
Function date_Paques(année As Integer) As String
Dim a, b, c, d, e, f, g, h, i, k, l, m, r, mois, jour
a = année Mod 19
b = année \ 100
c = année Mod 100
d = b \ 4
e = b Mod 4
f = (b + 8) \ 25
g = (b - f + 1) \ 3
h = (19 * a + b - d - g + 15) Mod 30
i = c \ 4
k = c Mod 4
l = (32 + 2 * e + 2 * i - h - k) Mod 7
m = (a + 11 * h + 22 * l) \ 451
r = (114 + h + l - 7 * m)
mois = r \ 31
jour = r Mod 31 + 1
date_Paques = DateSerial(année, mois, jour)
End Function