convertir la date grégorienne en date hijri

**morobaboumar** · 19/02/2016, 23h56

Salut.
Comment pourrais-je créer un champ date/heure qui pour contenir rien que la date hijri (calendrier musulan)?
Aidez moi membres du forum.

Très cordialement.

**User** · 20/02/2016, 11h58

Bonjour,

Voici un module VBA qui fait cette conversion, il s'agit de la fonction chrToIsl :

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
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 = "Monday"
 
                    ElseIf (wdn = 1) Then
                        weekDay = "Tuesday"
 
                    ElseIf (wdn = 2) Then
                        weekDay = "Wednesday"
 
                    ElseIf (wdn = 3) Then
                        weekDay = "Thursday"
 
                    ElseIf (wdn = 4) Then
                        weekDay = "Friday"
 
                    ElseIf (wdn = 5) Then
                        weekDay = "Saturday"
 
                    ElseIf (wdn = 6) Then
                        weekDay = "Sunday"
                    Else
                       weekDay = ""
                    End If
End Function
 
 
Function chrToIsl(dt As Date) As Date
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 = DateSerial(y, m, d)
 
End Function
 
Function islToChr(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 = DateSerial(y, m, d)
 
End Function

**morobaboumar** · 24/02/2016, 16h06

Envoyé par User

Bonjour,

Voici un module VBA qui fait cette conversion, il s'agit de la fonction chrToIsl :

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
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 = "Monday"
 
                    ElseIf (wdn = 1) Then
                        weekDay = "Tuesday"
 
                    ElseIf (wdn = 2) Then
                        weekDay = "Wednesday"
 
                    ElseIf (wdn = 3) Then
                        weekDay = "Thursday"
 
                    ElseIf (wdn = 4) Then
                        weekDay = "Friday"
 
                    ElseIf (wdn = 5) Then
                        weekDay = "Saturday"
 
                    ElseIf (wdn = 6) Then
                        weekDay = "Sunday"
                    Else
                       weekDay = ""
                    End If
End Function
 
 
Function chrToIsl(dt As Date) As Date
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 = DateSerial(y, m, d)
 
End Function
 
Function islToChr(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 = DateSerial(y, m, d)
 
End Function

Je vous remercie de m'avoir envoyé une suite à mon courrier.
Très cordialement.

**morobaboumar** · 24/02/2016, 19h27

J'ai reçu le code suivant:

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
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 = "Monday"
 
ElseIf (wdn = 1) Then weekDay = "Tuesday"
 
ElseIf (wdn = 2) Then weekDay = "Wednesday"
 
ElseIf (wdn = 3) Then weekDay = "Thursday"
 
ElseIf (wdn = 4) Then weekDay = "Friday"
 
ElseIf (wdn = 5) Then weekDay = "Saturday"
 
ElseIf (wdn = 6) Then weekDay = "Sunday"
 
Else
weekDay = ""
End If
 
End Function
 
 
Function chrToIsl(dt As Date) As Date
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)))) / 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 = DateSerial(y, m, d)
End Function
 
Function islToChr(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 = DateSerial(y, m, d)
End Function

Alors j'aimerais savoir comment l'exécute t-on dans un formulaire ?
Merci.

**User** · 24/02/2016, 19h38

Bonsoir,

Dans un formulaire, vous pouvez mettre à jour la propriété source contrôle d'une zone de texte comme ceci :

Code :

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

=chrToIsl([ChampDate])

Dans une requête vous pouvez aussi créer un champ calculé comme celà:

Code :

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

DateIsl: chrToIsl([ChampDate])

et appeler ce champ dans vôtre formulaire...

Cdlt,

**morobaboumar** · 25/02/2016, 10h55

NB: Je vous signale que le code marche parfaitement.
Mais je dois apporter une correction au niveau de la conversion, car dans l’année hijirienne, nous sommes le 16/5/1437
je vous envoie un pièce jointe pour vérification.
Merci encore infiniment de m'aider à corriger mes erreurs.

**User** · 25/02/2016, 13h06

Bonjour,

Il faudrait corriger la fonction comme ceci :

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
Function chrToIsl(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 = d & "/" & m & "/" & y ' DateSerial(y, m, d)
 
End Function

à+

**morobaboumar** · 25/02/2016, 22h49

Merci infiniment.
Formidable, le code de Conversion de la date grégorien en date hijri marche bien.
Je vous remercie infiniment, et vous fais savoir que le code marche comme souhaité.
Est-il possible de formater cette conversion en date général où le nom du jour/mois/année est affiché?
Exemple:jeudi 17 joumadal oula 1437.

**User** · 26/02/2016, 11h56

Bonjour,

J'ai modifié le module :

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
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(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 = weekDay(jd Mod 7) & " " & d & " " & moisToIsl(m) & " " & y '
 
End Function
 
Function islToChr(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 = DateSerial(y, m, d)
 
End Function

Cdlt,

**morobaboumar** · 26/02/2016, 15h53

Je suis vraiment émerveillé. Fort est de reconnaître votre statut d'excellence.
Merci merci infiniment.

**User** · 26/02/2016, 16h08

De rien,

J'ai simplement adapté le code contenu dans la source d'une page web.

Pouvez-vous clore la discussion ?

Merci

**morobaboumar** · 26/02/2016, 18h00

Envoyé par User

De rien,

J'ai simplement adapté le code contenu dans la source d'une page web.

Pouvez-vous clore la discussion ?

Merci

Merci! Je m'arrête ici tout en espérant vous retrouver bientôt.

**User** · 26/02/2016, 19h48

Envoyé par morobaboumar

Merci! Je m'arrête ici tout en espérant vous retrouver bientôt.

Dans ce cas je vous invite à clore la discussion et à en ouvrir une nouvelle si nécessaire.

Cdlt,

**morobaboumar** · 01/03/2016, 12h05

Bonjour.
Membres du forum,
Permettez moi de rouvrir cette discussion.

Je reviens vous demander s'il est possible de faire la correspondance en langue arabe
de la date hijiri selon l'exemple suivant:
Nom : DateHejiri.png
Affichages : 563
Taille : 19,4 Ko

Nom : DateHejiri.png
Affichages : 563
Taille : 19,4 Ko

.

Je signale que dans l'exemple de base de données que je vous renvoie,
j'ai créé une table de corresponce:Tbl_JoursDelaSemaine et une autre table: Tbl_MoisDeLAnnee.

Alors expliquez moi comment dois je faire pour pouvoir afficher la date Hijiri en écriture arabe.

Merci de me comprendre.
Très cordialement

**User** · 02/03/2016, 14h27

Bonjour,

Il faudrait ajouter au module ces 2 fonctions :

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

Le module "MduConversionDateGregorienne_Hijiri_Plus" devient :

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

Cdlt,

**morobaboumar** · 11/03/2016, 16h32

Salut membre du forum.
Je vous prie de m'aider à recorriger le code de conversion de date grégorienne en
date hijiri car il affiche: Vendredi 01 joumada thani 1437. Par contre aujourd'hui nous
sommes Vendredi 02 joumada thani 1437.
Nom : ConversionDate.png
Affichages : 574
Taille : 85,9 Ko

Nom : ConversionDate.png
Affichages : 574
Taille : 85,9 Ko

Pièces jointes: 1-Image affichant la conversion de dates
2- Copie de ma Base de données CalendrierHijiri
3- Image d'affichage de date hijiri sous excell
Qestion:
Peut-on adapter l'affichage de date Hijiri d'Excel à Access?
Comment pourrais-je corriger le code en cas de besoin?

convertir la date grégorienne en date hijri [Toutes versions]

Access

Discussions similaires

Partager

Partager