Re : formule qui ne marche plus...
Bonjour Cathy, Gérard,
Avec une fonction personnalisée à mettre dans libreoffice:
Voici un exemple d'application pratique avec une fonction DATE_DIF qui va calculer des écarts entre 2 dates.
Suivant les options possibles, les résultats peuvent être combinés en jours,
semaines, mois, années. La syntaxe sera :
DATE_DIF(DateDebut; DateFin; Unite1; Unite2;
Unite3; [SemaineDebut; [AnneeDebut]])
[TABLE="width: 100%"]
[TR]
[TD]
[TABLE="width: 100%"]
[TR="class: TxtTabTitr"]
[TD]Unité
[/TD]
[TD]Commentaires
[/TD]
[/TR]
[TR]
[TD="class: TxtCTab1"]Y ou A
[/TD]
[TD="class: TxtTab1"]Le nombre d'années entières comprises dans la période (Y pour
compatibilité Excel)
[/TD]
[/TR]
[TR]
[TD="class: TxtCTab1"]M ou YM
[/TD]
[TD="class: TxtTab1"]La différence entre les mois de DateDebut et DateFin. Les
jours et les années des dates ne sont pas pris en compte. (YM pour compatibilité
Excel)
[/TD]
[/TR]
[TR]
[TD="class: TxtCTab1"]D ou J ou MD
[/TD]
[TD="class: TxtTab1"]La différence entre les jours de DateDebut et DateFin. Les
mois et les années des dates ne sont pas pris en compte. (D ou MD pour
compatibilité Excel)
[/TD]
[/TR]
[TR]
[TD="class: TxtCTab1"]YD
[/TD]
[TD="class: TxtTab1"]La différence entre les jours de DateDebut et DateFin. Les
années des dates ne sont pas prises en compte. (YD pour compatibilité
Excel)
[/TD]
[/TR]
[TR]
[TD="class: TxtCTab1"]W
[/TD]
[TD="class: TxtTab1"]Différences en semaines
[/TD]
[/TR]
[TR]
[TD="class: TxtCTab1"]WW
[/TD]
[TD="class: TxtTab1"]Différences en semaines. L'option SemaineDebut a une action
[/TD]
[/TR]
[TR]
[TD="class: TxtCTab1"]SemaineDebut
[/TD]
[TD="class: TxtTab1"]Option. Utile uniquement avec W
ou WW
[/TD]
[/TR]
[TR]
[TD="class: TxtCTab1"]AnneeDebut
[/TD]
[TD="class: TxtTab1"]Option. Utile uniquement avec WW
et si SemaineDebut
présent
[/TD]
[/TR]
[/TABLE]
[/TD]
[TD]
[TABLE="width: 100%"]
[TR="class: TxtTabTitr"]
[TD]SemaineDebut
[/TD]
[TD]Commentaires
[/TD]
[/TR]
[TR]
[TD="class: TxtCTab1"][/TD]
[TD="class: TxtTab1"]Valeur système par défaut
[/TD]
[/TR]
[TR]
[TD="class: TxtCTab1"]1
[/TD]
[TD="class: TxtTab1"]Dimanche (par défaut)
[/TD]
[/TR]
[TR]
[TD="class: TxtCTab1"]2
[/TD]
[TD="class: TxtTab1"]Lundi
[/TD]
[/TR]
[TR]
[TD="class: TxtCTab1"]3
[/TD]
[TD="class: TxtTab1"]Mardi
[/TD]
[/TR]
[TR]
[TD="class: TxtCTab1"]4
[/TD]
[TD="class: TxtTab1"]Mercredi
[/TD]
[/TR]
[TR]
[TD="class: TxtCTab1"]5
[/TD]
[TD="class: TxtTab1"]Jeudi
[/TD]
[/TR]
[TR]
[TD="class: TxtCTab1"]6
[/TD]
[TD="class: TxtTab1"]vendredi
[/TD]
[/TR]
[TR]
[TD="class: TxtCTab1"]7
[/TD]
[TD="class: TxtTab1"]Samedi
[/TD]
[/TR]
[/TABLE]
[/TD]
[/TR]
[/TABLE]
- Function Date_Dif(DateDebut As
Variant, DateFin As
Variant, Unite1 As
String, Optional Unite2 As String, _
Optional Unite3 As String, Optional SemaineDeb As Variant, Optional AnneeDeb As Integer) As String
- '-----------------------------------
- ' DATE_DIF Préversion Novembre 2006
- ' Le tableur Calc par l'exemple
- ' Tutorial - Tableur Calc d'OpenOffice.org par l'exemple
- '-----------------------------------
- Dim Txt(3) As String
- '
- If IsMissing(Unite2) Then
Unite2=""
- If IsMissing(Unite3) Then
Unite3=""
- If IsMissing(SemaineDeb) Then
SemaineDeb=0
- If IsMissing(AnneeDeb) Then
AnneeDeb=0
- '
- On Error Goto GestionErreurs
- OK = False
- '
- For i = 1 To 3
- If i = 1 Then Unite = Unite1
- If i = 2 Then Unite = Unite2
- If i = 3 Then Unite = Unite3
- Gosub TraiteUnites
- Next i
- '
- If OK = False
Then 'aucun paramètre
- Date_Dif = "Err😀ate_Dif"
- Exit Function
- Endif
- '
- Dim A1 As Integer, A2 As Integer, AA As Integer
- Dim M1 As Integer, M2 As Integer, MM As Integer
- Dim J1 As Integer, J2 As Integer, JJ As Integer
- '
- A2 = Year(DateFin)
- A1 = Year(DateDebut)
- M2 = Month(DateFin)
- M1 = Month(DateDebut)
- J2 = Day(DateFin)
- J1 = Day(DateDebut)
- '
- 'Calcul YD différence en jours, une fois les années
soustraites
- Bissextile = ((A1 Mod 100 ‹› 0) And (A1 Mod 4 = 0)) Or (A1 Mod 400 = 0) 'Année début bissextile ?
- YD = DateSerial(A2, M2, J2) - DateSerial(A2, M1,
J1)
- If YD‹0 Then
- YD = (DateSerial(A1, 12, 31) - DateSerial(A1, M1, J1)) + (DateSerial(A2, M2, J2) -
DateSerial(A2, 1, 1))
- Endif
- If Bissextile‹0 Then
- If M1‹2 Then
- YD = YD - Bissextile
- Endif
- Endif
- ' fin YD
- '
- If M2=1 Then
- JourDansMoisFinPrec = 31
- Else
- JourDansMoisFinPrec = DateSerial(A2, M2,
1) - DateSerial(A2,
M2-1, 1)
- Endif
- '
- AA = A2-A1
- '
- If M2›=M1 Then
- MM = M2 - M1
- Else
- MM = M2 - M1 + 12
- AA = AA - 1
- Endif
- '
- If (J2-J1)‹0 Then
- JJ = J2 - J1 + JourDansMoisFinPrec
- If MM ‹1 Then
- MM = MM + 11
- AA = AA - 1
- Else
- MM = MM - 1
- Endif
- Else
- JJ = J2 - J1
- Endif
- '
- Assemblage =
""
- For n = 1 to 3
- If n = Jours
Then
- Assemblage = Assemblage & JJ &
Txt(n)
- Elseif n =
Mois Then
- Assemblage = Assemblage & MM &
Txt(n)
- ElseIf n =
Annees Then
- Assemblage = Assemblage & AA &
Txt(n)
- ElseIf n =
CasYd Then
- Assemblage = Assemblage & YD &
Txt(n)
- ElseIf n =
CasW Or n =
CasWW Then
- If n =
CasW Then Param =
"w" Else Param =
"ww"
- Assemblage = Assemblage & DateDiff (Param,
DateDebut, DateFin , SemaineDeb , AnneeDeb) & Txt(n)
- Endif
- Next n
- '
- Date_Dif = Assemblage
- '
- Exit Function
- '
- '---
- TraiteUnites:
- If Unite‹›"" Then
- Pv = Instr(Unite, ",")
- If Pv =
0 Then
- Pv = Instr(Unite, ";")
- Endif
- If Pv ›
0 Then
- TxtLu = Right(Unite, Len(Unite) - Pv)
- UnProv = Ucase(Trim(Left(Unite, Pv-1)))
- Else
- UnProv = Ucase(Trim(Unite))
- Endif
- '
- If UnProv =
"Y" Or UnProv = "A" Then
- Annees = i
- Txt(i) = TxtLu
- OK = True
- ElseIf UnProv = "M" Or UnProv = "YM" Then
- Mois = i
- Txt(i) = TxtLu
- OK = True
- ElseIf UnProv = "D" Or UnProv = "J" Or UnProv = "MD" Then
- Jours = i
- Txt(i) = TxtLu
- OK = True
- ElseIf UnProv = "YD" Then 'Excel : diff. jours, une fois
les années soustraites
- CasYd = i
- Txt(i) = TxtLu
- OK = True
- ElseIf UnProv = "W" Then
- CasW = i
- Txt(i) = TxtLu
- OK = True
- ElseIf UnProv = "WW" Then
- casWW = i
- Txt(i) = TxtLu
- OK = True
- Endif
- Endif
- Return
- '
- '
- GestionErreurs:
- 'MsgBox "Erreur ligne " & Erl & chr(13) &
"Erreur n°" & Err
- If Err = 449 Then 'paramètre absent
- Resume Next
- ElseIf Err =
13 Then
- MsgBox("Incompatibilité de type")
- Exit Function
- Endif
- '
- End Function
Cela n'est pas de moi, mais de
Tutorial - Tableur Calc d'OpenOffice.org par l'exemple
