Mise à jour de la date hijri

**morobaboumar** · 11/08/2016, 01h27

Salut membres du forum.
Comment pourrais corriger la date hijiri en cas de décalage du mois lunaire qui ne correspondrais pas avec le calendrier lunaire.
J'aimerais créer un formulaire-Boite de dialogue me permettant de faire cette correction (mise) grace à un code.

Voici les codes que j'ai reçus:
1°)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Public Function WeekDayAr(j As Long) As String ' Traduction du jour de la semaine.
   WeekDayAr = DLookup("L_JourAr", "Tbl_JoursDelaSemaine", "ID_Jour=" & (j + 1))
End Function
 
Public Function MoisAr(m As Long) As String ' Traduction du mois.
    MoisAr = DLookup("L_MoisAr", "Tbl_MoisDelAnnee", "ID_Mois=" & m)
End Function

2°)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
 
Option Compare Database
Option Explicit
 
Public Function RoundUp(vValeur As Variant, Optional byNbDec As Byte) As Variant
   RoundUp = -Int(-vValeur * 10 ^ byNbDec) / 10 ^ byNbDec
End Function
 
Public Function RoundDown(vValeur As Variant, Optional byNbDec As Byte) As Variant
   RoundDown = Int(vValeur * 10 ^ byNbDec) / 10 ^ byNbDec
End Function
 
Function intPart(floatNum As Double) As Long
 
   If (floatNum < -0.0000001) Then
      intPart = RoundUp(floatNum - 0.0000001)
   Else
      intPart = RoundDown(floatNum + 0.0000001)
   End If
 
End Function
 
Function weekDay(wdn) As String
                    If (wdn = 0) Then
                        weekDay = "Lundi"
 
                    ElseIf (wdn = 1) Then
                        weekDay = "Mardi"
 
                    ElseIf (wdn = 2) Then
                        weekDay = "Mercredi"
 
                    ElseIf (wdn = 3) Then
                        weekDay = "Jeudi"
 
                    ElseIf (wdn = 4) Then
                        weekDay = "Vendredi"
 
                    ElseIf (wdn = 5) Then
                        weekDay = "Samedi"
 
                    ElseIf (wdn = 6) Then
                        weekDay = "Dimanche"
                    Else
                       weekDay = ""
                    End If
End Function
 
 
Public Function moisToIsl(m As Long) As String
 
Select Case m
 
Case 1
moisToIsl = "Mouharram"
 
Case 2
moisToIsl = "Safar"
 
Case 3
moisToIsl = "Rabi' Awwal"
 
Case 4
moisToIsl = "Rabi' Thani"
 
Case 5
moisToIsl = "Joumada Awwal"
 
Case 6
moisToIsl = "Joumada Thani"
 
Case 7
moisToIsl = "Rajab"
 
Case 8
moisToIsl = "Cha'ban"
 
Case 9
moisToIsl = "Ramadan"
 
Case 10
moisToIsl = "Chawwal"
 
Case 11
moisToIsl = "Dhoul Qa'da"
 
Case 12
moisToIsl = "Dhoul Hijja"
 
End Select
 
End Function
 
 
Function chrToIsl_Plus(dt As Date) As String
Dim d As Long, m As Long, y As Long, j As Long, jd As Long, l As Long, n As Long
 
    d = Day(dt)
    m = Month(dt)
    y = Year(dt)
 
        If ((y > 1582) Or ((y = 1582) And (m > 10)) And ((y = 1582) And (m = 10) And (d > 14))) Then
 
           jd = intPart((1461 * (y + 4800 + intPart((m - 14) / 12))) / 4) + intPart((367 * (m - 2 - 12 * (intPart((m - 14) / 12)))) / 12) - _
    intPart((3 * (intPart((y + 4900 + intPart((m - 14) / 12)) / 100))) / 4) + d - 32075
 
        Else
 
           jd = 367 * y - intPart((7 * (y + 5001 + intPart((m - 9) / 7))) / 4) + intPart((275 * m) / 9) + d + 1729777
 
        End If
 
    l = jd - 1948440 + 10632
    n = intPart((l - 1) / 10631)
    l = l - 10631 * n + 354
    j = (intPart((10985 - l) / 5316)) * (intPart((50 * l) / 17719)) + (intPart(l / 5670)) * (intPart((43 * l) / 15238))
    l = l - (intPart((30 - j) / 15)) * (intPart((17719 * j) / 50)) - (intPart(j / 16)) * (intPart((15238 * j) / 43)) + 29
    m = intPart((24 * l) / 709)
    d = l - intPart((709 * m) / 24)
    y = 30 * n + j - 30
 
    chrToIsl_Plus = WeekDayAr(jd Mod 7) & " " & d & " " & MoisAr(m) & " " & y '
 
End Function
 
Function islToChr_Plus(dt As Date) As Date
Dim d As Long, m As Long, y As Long, i As Long, j As Long, k As Long, jd As Long, l As Long, n As Long
 
    d = (Day(dt))
    m = (Month(dt))
    y = (Year(dt))
    jd = intPart((11 * y + 3) / 30) + 354 * y + 30 * m - intPart((m - 1) / 2) + d + 1948440 - 385
 
        If (jd > 2299160) Then
 
            l = jd + 68569
            n = intPart((4 * l) / 146097)
            l = l - intPart((146097 * n + 3) / 4)
            i = intPart((4000 * (l + 1)) / 1461001)
            l = l - intPart((1461 * i) / 4) + 31
            j = intPart((80 * l) / 2447)
            d = l - intPart((2447 * j) / 80)
            l = intPart(j / 11)
            m = j + 2 - 12 * l
            y = 100 * (n - 49) + i + l
 
        Else
 
            j = jd + 1402
            k = intPart((j - 1) / 1461)
            l = j - 1461 * k
            n = intPart((l - 1) / 365) - intPart(l / 1461)
            i = l - 365 * n + 30
            j = intPart((80 * i) / 2447)
            d = i - intPart((2447 * j) / 80)
            i = intPart(j / 11)
            m = j + 2 - 12 * i
            y = 4 * k + n + i - 4716
 
        End If
 
  islToChr_Plus = DateSerial(y, m, d)
 
End Function
 
Public Function WeekDayAr(j As Long) As String
   WeekDayAr = DLookup("L_JourAr", "Tbl_JoursDelaSemaine", "ID_Jour=" & (j + 1))
End Function
 
Public Function MoisAr(m As Long) As String
    MoisAr = DLookup("L_MoisAr", "Tbl_MoisDelAnnee", "ID_Mois=" & m)
End Function

**marot_r** · 15/08/2016, 20h48

Bonjour.

Il semblerai que Access soit capable en standard de gérer les dates hijri avec Date$().

Ici un article qui fait référence :
https://support.office.com/en-us/art...5-01e0bfbfed76

A+

**morobaboumar** · 16/03/2020, 12h05

Envoyé par morobaboumar

Salut membres du forum.
Comment pourrais corriger la date hijiri en cas de décalage du mois lunaire qui ne correspondrais pas avec le calendrier lunaire.
J'aimerais créer un formulaire-Boite de dialogue me permettant de faire cette correction (mise) grace à un code.

Voici les codes que j'ai reçus:
1°)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Public Function WeekDayAr(j As Long) As String ' Traduction du jour de la semaine.
   WeekDayAr = DLookup("L_JourAr", "Tbl_JoursDelaSemaine", "ID_Jour=" & (j + 1))
End Function
 
Public Function MoisAr(m As Long) As String ' Traduction du mois.
    MoisAr = DLookup("L_MoisAr", "Tbl_MoisDelAnnee", "ID_Mois=" & m)
End Function

2°)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
 
Option Compare Database
Option Explicit
 
Public Function RoundUp(vValeur As Variant, Optional byNbDec As Byte) As Variant
   RoundUp = -Int(-vValeur * 10 ^ byNbDec) / 10 ^ byNbDec
End Function
 
Public Function RoundDown(vValeur As Variant, Optional byNbDec As Byte) As Variant
   RoundDown = Int(vValeur * 10 ^ byNbDec) / 10 ^ byNbDec
End Function
 
Function intPart(floatNum As Double) As Long
 
   If (floatNum < -0.0000001) Then
      intPart = RoundUp(floatNum - 0.0000001)
   Else
      intPart = RoundDown(floatNum + 0.0000001)
   End If
 
End Function
 
Function weekDay(wdn) As String
                    If (wdn = 0) Then
                        weekDay = "Lundi"
 
                    ElseIf (wdn = 1) Then
                        weekDay = "Mardi"
 
                    ElseIf (wdn = 2) Then
                        weekDay = "Mercredi"
 
                    ElseIf (wdn = 3) Then
                        weekDay = "Jeudi"
 
                    ElseIf (wdn = 4) Then
                        weekDay = "Vendredi"
 
                    ElseIf (wdn = 5) Then
                        weekDay = "Samedi"
 
                    ElseIf (wdn = 6) Then
                        weekDay = "Dimanche"
                    Else
                       weekDay = ""
                    End If
End Function
 
 
Public Function moisToIsl(m As Long) As String
 
Select Case m
 
Case 1
moisToIsl = "Mouharram"
 
Case 2
moisToIsl = "Safar"
 
Case 3
moisToIsl = "Rabi' Awwal"
 
Case 4
moisToIsl = "Rabi' Thani"
 
Case 5
moisToIsl = "Joumada Awwal"
 
Case 6
moisToIsl = "Joumada Thani"
 
Case 7
moisToIsl = "Rajab"
 
Case 8
moisToIsl = "Cha'ban"
 
Case 9
moisToIsl = "Ramadan"
 
Case 10
moisToIsl = "Chawwal"
 
Case 11
moisToIsl = "Dhoul Qa'da"
 
Case 12
moisToIsl = "Dhoul Hijja"
 
End Select
 
End Function
 
 
Function chrToIsl_Plus(dt As Date) As String
Dim d As Long, m As Long, y As Long, j As Long, jd As Long, l As Long, n As Long
 
    d = Day(dt)
    m = Month(dt)
    y = Year(dt)
 
        If ((y > 1582) Or ((y = 1582) And (m > 10)) And ((y = 1582) And (m = 10) And (d > 14))) Then
 
           jd = intPart((1461 * (y + 4800 + intPart((m - 14) / 12))) / 4) + intPart((367 * (m - 2 - 12 * (intPart((m - 14) / 12)))) / 12) - _
    intPart((3 * (intPart((y + 4900 + intPart((m - 14) / 12)) / 100))) / 4) + d - 32075
 
        Else
 
           jd = 367 * y - intPart((7 * (y + 5001 + intPart((m - 9) / 7))) / 4) + intPart((275 * m) / 9) + d + 1729777
 
        End If
 
    l = jd - 1948440 + 10632
    n = intPart((l - 1) / 10631)
    l = l - 10631 * n + 354
    j = (intPart((10985 - l) / 5316)) * (intPart((50 * l) / 17719)) + (intPart(l / 5670)) * (intPart((43 * l) / 15238))
    l = l - (intPart((30 - j) / 15)) * (intPart((17719 * j) / 50)) - (intPart(j / 16)) * (intPart((15238 * j) / 43)) + 29
    m = intPart((24 * l) / 709)
    d = l - intPart((709 * m) / 24)
    y = 30 * n + j - 30
 
    chrToIsl_Plus = WeekDayAr(jd Mod 7) & " " & d & " " & MoisAr(m) & " " & y '
 
End Function
 
Function islToChr_Plus(dt As Date) As Date
Dim d As Long, m As Long, y As Long, i As Long, j As Long, k As Long, jd As Long, l As Long, n As Long
 
    d = (Day(dt))
    m = (Month(dt))
    y = (Year(dt))
    jd = intPart((11 * y + 3) / 30) + 354 * y + 30 * m - intPart((m - 1) / 2) + d + 1948440 - 385
 
        If (jd > 2299160) Then
 
            l = jd + 68569
            n = intPart((4 * l) / 146097)
            l = l - intPart((146097 * n + 3) / 4)
            i = intPart((4000 * (l + 1)) / 1461001)
            l = l - intPart((1461 * i) / 4) + 31
            j = intPart((80 * l) / 2447)
            d = l - intPart((2447 * j) / 80)
            l = intPart(j / 11)
            m = j + 2 - 12 * l
            y = 100 * (n - 49) + i + l
 
        Else
 
            j = jd + 1402
            k = intPart((j - 1) / 1461)
            l = j - 1461 * k
            n = intPart((l - 1) / 365) - intPart(l / 1461)
            i = l - 365 * n + 30
            j = intPart((80 * i) / 2447)
            d = i - intPart((2447 * j) / 80)
            i = intPart(j / 11)
            m = j + 2 - 12 * i
            y = 4 * k + n + i - 4716
 
        End If
 
  islToChr_Plus = DateSerial(y, m, d)
 
End Function
 
Public Function WeekDayAr(j As Long) As String
   WeekDayAr = DLookup("L_JourAr", "Tbl_JoursDelaSemaine", "ID_Jour=" & (j + 1))
End Function
 
Public Function MoisAr(m As Long) As String
    MoisAr = DLookup("L_MoisAr", "Tbl_MoisDelAnnee", "ID_Mois=" & m)
End Function

Bonsoir EricDgn,

Maintenant, il me reste à trouver la solution au fait que souvent, il y a un décalage de plus ou moins d'un ou deux jours, comment le résoudre ?

Je voudrais ajouter un contrôle zone de liste déroulante
dont le contenu serait (1;2;3;4;5) qui me permettrait
de sélectionner le nombre de jours de décalage (+ ou -).
Cordialement.

**marot_r** · 17/03/2020, 18h01

Bonjour.

Peso j'irai vers une liste déroulante dont les valeurs serait -5, -4, -3, -2, -1, 0, +1, +2, +3, +4, +5.
Comme cela tu n'as plus qu'à lire la valeur directement et l'appliquer à ton calcul.

Un truc du genre : TaValeur=TaValeur + TaListe.

Sinon tu peux faire 2 listes, une pour le signe et une pour le jour.

Ça pourrait être

TaValeur=TaValeur + iif(TaListeSigne="+",1,-1) * TaListeValeur.

A+

**User** · 17/03/2020, 19h35

Bonjour,

Envoyé par marot_r

Bonjour.

Il semblerai que Access soit capable en standard de gérer les dates hijri avec Date$().

Ici un article qui fait référence :
https://support.office.com/en-us/art...5-01e0bfbfed76

A+

En effet, en VBA il y a la propriété Calendar qui permet de choisir le calendrier :

vbCalGreg
vbCalHijri

Par exemple, pour avoir la date du jour du calendrier Hijri, on peut faire :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Public Function DateJourHijri()
    Dim dtHeg As String
    Calendar = vbCalHijri
    dtHeg = Date
    DateJourHijri = dtHeg
    Calendar = vbCalGreg
End Function

Et pour convertir de grégorien à Hijri :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Public Function ConvertDateToHijri(dt As Date)
    Dim dtHeg As String
    Calendar = vbCalHijri
    dtHeg = dt
    ConvertDateToHijri = dtHeg
    Calendar = vbCalGreg
End Function

Cdlt,

**morobaboumar** · 18/03/2020, 00h25

Envoyé par User

Bonjour,
En effet, en VBA il y a la propriété Calendar qui permet de choisir le calendrier :

vbCalGreg
vbCalHijri

Par exemple, pour avoir la date du jour du calendrier Hijri, on peut faire :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Public Function DateJourHijri()
    Dim dtHeg As String
    Calendar = vbCalHijri
    dtHeg = Date
    DateJourHijri = dtHeg
    Calendar = vbCalGreg
End Function

Et pour convertir de grégorien à Hijri :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Public Function ConvertDateToHijri(dt As Date)
    Dim dtHeg As String
    Calendar = vbCalHijri
    dtHeg = dt
    ConvertDateToHijri = dtHeg
    Calendar = vbCalGreg
End Function

Cdlt,

Bonsoir marot_r,
bonsoir User,

Voici comment j'ai appelé les fonctions dans deux zones de textes:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

=DateJourHijri()

et çà me donne la date grégorienne,

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

=ConvertDateToHijri([DateHegiriennne])

pareille.

Nom : CaptureCalendrierHEJIR_1.PNG
Affichages : 183
Taille : 18,9 Ko

Cordialement.

**morobaboumar** · 18/03/2020, 00h43

Envoyé par marot_r

Bonjour.
Peso j'irai vers une liste déroulante dont les valeurs serait -5, -4, -3, -2, -1, 0, +1, +2, +3, +4, +5.
Comme cela tu n'as plus qu'à lire la valeur directement et l'appliquer à ton calcul.
Un truc du genre : TaValeur=TaValeur + TaListe.
Sinon tu peux faire 2 listes, une pour le signe et une pour le jour.
Ça pourrait être
TaValeur=TaValeur + iif(TaListeSigne="+",1,-1) * TaListeValeur.
A+

Bonsoir marot_r,

J'ai créé la liste déroulante "MaListeJourDecalage" avec les valeur recommandées.

Je ne comprends pas comment concilier les codes:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

<span style="font-family: monospace; padding: 2px; background: #ddd; display: inline-block">TaValeur=TaValeur + TaListe</span>.

TaValeur=TaValeur + iif(TaListeSigne="+",1,-1) * TaListeValeuravec

les fonctions

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
 
 
Function chrToIsl_Plus(dt As Date) As String
Dim d As Long, m As Long, y As Long, j As Long, jd As Long, l As Long, n As Long
 
    d = Day(dt)
    m = Month(dt)
    y = Year(dt)
 
        If ((y > 1582) Or ((y = 1582) And (m > 10)) And ((y = 1582) And (m = 10) And (d > 14))) Then
 
           jd = intPart((1461 * (y + 4800 + intPart((m - 14) / 12))) / 4) + intPart((367 * (m - 2 - 12 * (intPart((m - 14) / 12)))) / 12) - _
    intPart((3 * (intPart((y + 4900 + intPart((m - 14) / 12)) / 100))) / 4) + d - 32075
 
        Else
 
           jd = 367 * y - intPart((7 * (y + 5001 + intPart((m - 9) / 7))) / 4) + intPart((275 * m) / 9) + d + 1729777
 
        End If
 
    l = jd - 1948440 + 10632
    n = intPart((l - 1) / 10631)
    l = l - 10631 * n + 354
    j = (intPart((10985 - l) / 5316)) * (intPart((50 * l) / 17719)) + (intPart(l / 5670)) * (intPart((43 * l) / 15238))
    l = l - (intPart((30 - j) / 15)) * (intPart((17719 * j) / 50)) - (intPart(j / 16)) * (intPart((15238 * j) / 43)) + 29
    m = intPart((24 * l) / 709)
    d = l - intPart((709 * m) / 24)
    y = 30 * n + j - 30
 
    chrToIsl_Plus = weekDay(jd Mod 7) & " " & d & " " & moisToIsl(m) & " " & y '
 
End Function

Cordialement.

**User** · 18/03/2020, 14h24

Bonjour,

Il faut remettre le mode calendrier grégorien à la fin de la fonction :

Voici comment appeler les fonctions :

Sur ouverture du formulaire mettre le code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Private Sub Form_Open(Cancel As Integer)
    Dim dtGreg As String, dtHeg As String
 
    Calendar = vbCalGreg
    dtGreg = Date
    Me.DateGregorienne = dtGreg
 
    Calendar = vbCalHijri
    dtHeg = Date
    Me.DateHegirienne = dtHeg
 
    Calendar = vbCalGreg
 
End Sub

**marot_r** · 18/03/2020, 15h44

Bonjour morobaboumar.

Excuse mon inculture dans le domaine mais tu ne peux pas stocker le résultat sous forme de date ? C'est forcément un texte ?

L'idée que j'avais c'était de prendre la date calculée et de lui ajouter le décalage donc c'était quelque chose du genre :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
DateHijri=CalculerDateHijri(DateGergorienne)
DateHijri=DateHijri+Decalcage.

Bon pour le +Déclage il faut peut-être se le programmer à la main si on ne peut pas utiliser dateAdd().

Est-ce que tu peux mettre une brève explication sur le calendrier Hijri ?
Par exemple, a-t'il 12 mois par an ?
Est-ce que le nombre de jours dans les mois est variable ou le même pour tous les mois ?
Est-ce que le nombre de jours d'un mois peut changer avec l'année (comme février) ?
Ça aiderai à savoir comment t'aider.

A+

**morobaboumar** · 18/03/2020, 18h40

Envoyé par marot_r

Bonjour morobaboumar.
1°) Est-ce que tu peux mettre une brève explication sur le calendrier Hijri ?
Par exemple, a-t'il 12 mois par an ?
2°) Est-ce que le nombre de jours dans les mois est variable ou le même pour tous les mois ?
3°) Est-ce que le nombre de jours d'un mois peut changer avec l'année (comme février) ?
Ça aiderai à savoir comment t'aider.
A+

Bonsoir marot_r,
bonsoir User,

Réponses:

1°) et 2°) L'année Hijri comprend 12 mois (360 jours) dont les mois varient entre 29 et 30 jours; c'est à dire: si un 1er mois est sur 30 jours, le second peut se limiter à 29. Tout dépend de l’apparition du croissant lunaire.
C'est pourquoi vous trouverez dans le calendrier Hijri, souvent un décalage au niveau du nombre de jours par rapport à
l'apparition du croissant lunaire selon les régions. Mais unanimement l'année Hijri comprend 12 mois (360 jours) dont les jours du mois peuvent varier entre 29 et 30 jours
3°) Pas de mois dont les jours sont en dessous de 29.

C'est pourquoi je recherche une méthode me permettant de mettre le nombre de jours à jour dans le mois hijiri s'il y a un
décalage de jour selon l'apparition du croissant lunaire dans notre région.
Exemple, d'après le code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

chrToIsl_Plus

, la date affichée est "Mercredi 23 Rajab 1441" alors que selon l'apparition du croissant lunaire dans notre région, nous sommes en avance de 2 jours, pour corriger cette avance, je dois régler mon calendrier
hijiri en faisant (-2 jours) ou (+2 jours) si nous sommes en retard de 2 jours.

Nom : CaptureCalendrierHEJIR_2.PNG
Affichages : 179
Taille : 9,7 Ko

Nom : CaptureCalendrierHEJIR_2.PNG
Affichages : 179
Taille : 9,7 Ko

J'ai essayé cette méthode mais ne marche pas.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

="Hegire:" & "" & chrToIsl_Plus([CtrlDateGregorienne])+[MaListeJourDecalage]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Me.ApercuDateGejiriDecalage = CtrlDateHijiri + MaListeJourDecalage

Cordialement.

**marot_r** · 18/03/2020, 19h31

OK, et moi qui trouvais les calculs d'années bissextiles complexes …

Et si je comprend bien tu as une sorte de "décalage lunaire" entre divers lieu, un peu comme on a un décalage horaire entre la France et le Québec ? C'est bien cela ?

Si on reprend ton exemple, avec le mois Rajab.
Si la date calculée était le 29 rajab 1441, quelle date serai 29 rajab 1441 +1j ? Le 30 du mois ? Le 1er du mois suivant ?
Est-ce que serait la même date pour l'année 1442 et les suivantes ou les précédentes ?

De même que serait 1 rajab 1441 -1j ? le 30 du mois précédent ? le 29 du mois précédent ? Ça dépend ?

Il n'y a pas un service Internet qui te donnerai cette information pour l'ensemble de la terre ?

A+

**morobaboumar** · 18/03/2020, 22h43

Envoyé par marot_r

OK, et moi qui trouvais les calculs d'années bissextiles complexes …
Et si je comprend bien tu as une sorte de "décalage lunaire" entre divers lieu, un peu comme on a un décalage horaire entre la France et le Québec ? C'est bien cela ?
Si on reprend ton exemple, avec le mois Rajab.
Si la date calculée était le 29 rajab 1441, quelle date serai 29 rajab 1441 +1j ? Le 30 du mois ? Le 1er du mois suivant ?
Est-ce que serait la même date pour l'année 1442 et les suivantes ou les précédentes ?
De même que serait 1 rajab 1441 -1j ? le 30 du mois précédent ? le 29 du mois précédent ? Ça dépend ?
Il n'y a pas un service Internet qui te donnerai cette information pour l'ensemble de la terre ?
A+

Salut marot_r,
Je voudrais dire ajustement du calendrier hijiri.
Voir l'exemple de la capture d'écran d'une application androïde:

Nom : CaptureAjustementCalendrierHijiri2.png
Affichages : 168
Taille : 53,5 Ko

Nom : CaptureAjustementCalendrierHijiri2.png
Affichages : 168
Taille : 53,5 Ko

Nom : CaptureAjustementCalendrierHijiri.jpg
Affichages : 178
Taille : 160,3 Ko

J'espère que vous me comprendrez ?
Cordialement.

**marot_r** · 19/03/2020, 15h43

Bonjour et désolé de paraître obtus.

J'ai bien saisi que tu voulais ajouter ou retirer des jours à la date calculée.
Ce que je ne saisi pas c'est le résultat que tu vas avoir sur les exemples que j'ai mis plus haut.
À priori il va falloir qu'on le calcule soi-même et là je n'ai aucune idée de comment procéder.

As-tu essayé les solutions proposées par User ?

Généralement c'est plus sur d'utiliser une fonction système si elle existe.

A+

**morobaboumar** · 19/03/2020, 16h13

Envoyé par User

Bonjour,
Il faut remettre le mode calendrier grégorien à la fin de la fonction :
Voici comment appeler les fonctions :
Sur ouverture du formulaire mettre le code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Private Sub Form_Open(Cancel As Integer)
    Dim dtGreg As String, dtHeg As String
    Calendar = vbCalGreg
    dtGreg = Date
    Me.DateGregorienne = dtGreg
    Calendar = vbCalHijri
    dtHeg = Date
    Me.DateHegirienne = dtHeg
    Calendar = vbCalGreg
End Sub

Bonjour User,
bonjour marot_r,

Envoyé par marot_r

As-tu essayé les solutions proposées par User ?

Bien sure je l'ai essayée mais j'ai des messages d'erreurs qui apparaissaient.

Nom : CaptureCalendrierHEJIR_3.PNG
Affichages : 158
Taille : 25,1 Ko

Nom : CaptureCalendrierHEJIR_4.PNG
Affichages : 153
Taille : 17,8 Ko

Mais cela était du au fait que je n'avais pas créé les zones de teste indépendants "DateGregorienne" et "DateHegirienne"
pour recevoir les données ramenées par le code de User.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Private Sub Form_Open(Cancel As Integer)
    Dim dtGreg As String, dtHeg As String
    Calendar = vbCalGreg
    dtGreg = Date
    Me.DateGregorienne = dtGreg
    Calendar = vbCalHijri
    dtHeg = Date
    Me.DateHegirienne = dtHeg
    Calendar = vbCalGreg
End Sub

Nom : CaptureCalendrierHEJIR_5.PNG
Affichages : 151
Taille : 20,4 Ko

Le code marche.
Sauf votre respect, pourriez vous me dire comment faire en sorte que le code de User puisse afficher le format Date, complet ?
Puis le code d'ajustement de la date hijiri ?

Cordialement.

**morobaboumar** · 24/03/2020, 00h01

Envoyé par morobaboumar

Bonjour User,
bonjour marot_r,

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Private Sub Form_Open(Cancel As Integer)
    Dim dtGreg As String, dtHeg As String
    Calendar = vbCalGreg
    dtGreg = Date
    Me.DateGregorienne = dtGreg
    Calendar = vbCalHijri
    dtHeg = Date
    Me.DateHegirienne = dtHeg
    Calendar = vbCalGreg
End Sub

Le code marche.
Sauf votre respect, pourriez vous me dire comment faire en sorte que le code de User puisse afficher le format Date, complet de la date hijiri ?
Puis le code d'ajustement de la date hijiri ?

Bonsoir membres du forum,
Pourriez vous me dire comment faire en sorte que le code de User puisse afficher le format Date, complet de la date hijiri ?
Cordialement.

**User** · 24/03/2020, 09h57

Bonjour,

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Private Sub Form_Open(Cancel As Integer)
    Dim dtGreg As String, dtHeg As String
    Calendar = vbCalGreg
    dtGreg = Date
    Me.DateGregorienne = dtGreg
 
    Calendar = vbCalHijri
    dtHeg = Date
    Me.DateHegirienne = dtHeg
 
    ' code pour afficher la date générale :
    dtHeg = WeekDayAr(weekDay(date)) & " " & Day(date) & " " & MoisAr(Month(date)) & " " & Year(date)  ' soit cette ligne
    ' dtHeg = Format(date, "dddd") & " " & Day(date) & " " & moisToIsl(Month(date)) & " " & Year(date) '  ' soit cette ligne
 
    Me.DateHegirienneGenerale = dtHeg
 
    Calendar = vbCalGreg
 
End sub

Cdlt,

**morobaboumar** · 24/03/2020, 23h10

Bonsoir Membres du forum,
bonsoir User,
Voici comment j'ai réadapté le code
Nom : CaptureCalendrierHEJIR_6.PNG
Affichages : 142
Taille : 25,9 Ko

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
Option Compare Database
Option Explicit
 
Private Sub Form_Open(Cancel As Integer)
'______________________________
On Error Resume Next
'________________________________
 
    Dim dtGreg As String, dtHeg As String
    Calendar = vbCalGreg
    dtGreg = Date
    Me.DateGregorienne = "Gregorien:" & " " & dtGreg
    Calendar = vbCalHijri
    dtHeg = Date
    Me.DateHegirienne = "Hegire:" & " " & dtHeg
    Calendar = vbCalGreg
    '_________________________________________________
    '_________________________________________________
     Dim dtGreg_2 As String, dtHeg_2 As String
    Calendar = vbCalGreg
    dtGreg_2 = Date
    Me.DateGregorienne_2 = dtGreg_2
 
    Calendar = vbCalHijri
    dtHeg_2 = Date
    Me.DateHegirienne_2 = dtHeg_2
 
    ' code pour afficher la date générale :
    dtHeg_2 = WeekDayAr(WeekDayAr(Date)) & " " & Day(Date) & " " & MoisAr(Month(Date)) & " " & Year(Date)  ' soit cette ligne
    'dtHeg = Format(Date, "dddd") & " " & Day(Date) & " " & MoisAr(Month(Date)) & " " & Year(Date) '  ' soit cette ligne
 
    Me.DateHegirienneGenerale = dtHeg_2
 
    Calendar = vbCalGreg
End Sub
 
Public Function WeekDayAr(wdn) As String
                    If (wdn = 0) Then
                        WeekDayAr = "Lundi"
 
                    ElseIf (wdn = 1) Then
                        WeekDayAr = "Mardi"
 
                    ElseIf (wdn = 2) Then
                        WeekDayAr = "Mercredi"
 
                    ElseIf (wdn = 3) Then
                        WeekDayAr = "Jeudi"
 
                    ElseIf (wdn = 4) Then
                        WeekDayAr = "Vendredi"
 
                    ElseIf (wdn = 5) Then
                        WeekDayAr = "Samedi"
 
                    ElseIf (wdn = 6) Then
                        WeekDayAr = "Dimanche"
                    Else
                       WeekDayAr = ""
                    End If
End Function
 
 
Public Function MoisAr(m As Long) As String
 
Select Case m
 
Case 1
MoisAr = "Mouharram"
 
Case 2
MoisAr = "Safar"
 
Case 3
MoisAr = "Rabi' Awwal"
 
Case 4
MoisAr = "Rabi' Thani"
 
Case 5
MoisAr = "Joumada Awwal"
 
Case 6
MoisAr = "Joumada Thani"
 
Case 7
MoisAr = "Rajab"
 
Case 8
MoisAr = "Cha'ban"
 
Case 9
MoisAr = "Ramadan"
 
Case 10
MoisAr = "Chawwal"
 
Case 11
MoisAr = "Dhoul Qa'da"
 
Case 12
MoisAr = "Dhoul Hijja"
 
End Select
 
End Function

Nom : CaptureCalendrierHEJIR_6.PNG
Affichages : 134
Taille : 77,6 Ko

Ici, la date est en retard d’un jour par rapport à celle que renvoie le code de User.
Comment faut il agir sur les codes «chrToIsl» , «chrToIsl_Plus » et «chrToIsl_Plus_2 » afin que la date correcte s y affiche ?

Pièce jointe

Cordialement.

**marot_r** · 25/03/2020, 12h05

Bonjour.

C'est à priori parce que le jour trouvé n'est pas entre 0 et 6.

Et je suggère une version plus compacte du code de WeekDayAr.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Public Function WeekDayAr(wdn) As String
       dim result as string
       select case wdn
            case 0: result="Lundi"
            case 1: result="'Mardi"
            case 2: result="Mercredi"
            case 3: result="Jeudi"
            case 4: result="Vendredi"
            case 5: result="Samedi"
            case 6: result="Dimanche"
            case else : result="#Erreur " & wdn & " Inconnu#"
      end select
      WeekDayAr=result
End Function

A+

**morobaboumar** · 25/03/2020, 13h24

Bonjour membres du forum,
bonjour marot_r,
Voici l'erreur que ramène votre code:

#Erreur #Erreur 01/08/1441 Inconnu# Inconnu# 1 Cha'ban 1441

Nom : CaptureCalendrierHEJIR_7.PNG
Affichages : 147
Taille : 13,7 Ko

mais en mettant la ligne de code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

case else : result="#Erreur " & wdn & " Inconnu#"

en commentaire, voici
le résultat:

Nom : CaptureCalendrierHEJIR_8.PNG
Affichages : 160
Taille : 11,3 Ko

1- Comment résoudre ce manque d'affichage du nom du jour de la date ?

2-

La date est en retard d’un jour par rapport à celle que renvoie le code de User.
Comment faut il agir sur les codes «chrToIsl» , «chrToIsl_Plus » et «chrToIsl_Plus_2 » afin que la date correcte s y affiche ?

Cordialement.

**marot_r** · 25/03/2020, 13h39

Bonjour.

Le but du case else était justement de voir ce qu'on passait comme valeur donc je suggère fortement de le laisser. En temps normal, tu n'auras jamais cette valeur.

Et là apparemment on passe la date au lieu du jour (0 à 6) attendu par la fonction qui de plus semble appelée 2 fois.

Le code est probablement : WeekDayAr(WeekDay(Date)) au lieu de WeekDayAr(WeekDayAr(Date)).

A+

Mise à jour de la date hijri [AC-2013]

Access

Discussions similaires

Partager

Partager