منتدى فيجوال بيسك لكل العرب | منتدى المبرمجين العرب - الى محبي VB6 تحويل التاريخ الى الهجري مباشرة وصحيح بإذن الله

اتعبني الاختلاف بين تاريخ الجهاز والتاريخ الهجري ( أم القرى )
ولكن في اعتباري كل شيء وله حل
وكانت عملية حسابية متعبة
الى أن توصلت لحل للأعوام من
2015 الى 2026

وحبيت إني اساعد من يحتاج لمثل هذا الأمر

ضع في الموديل

كود :

Public Function Hi(ByVal DD As Byte, MM As Byte, YYYY As Long) As String

Dim A As Variant

Dim S As Long

Dim K() As String

If YYYY = 2015 Then A = Array(5780800, "20.8920.8991", "19.8919.8989", "20.8920.8991", "19.8919.8989", "18.8918.8989", "17.8917.8987", "16.8916.8987", "15.8915.8985", "13.8913.8984", "13.113.8983", "12.112.182", "11.111.182")

If YYYY = 2016 Then A = Array(5780800, "10.8910.8980", "9.8909.8979", "9.8909.8980", "7.8907.8978", "7.8907.8977", "5.8905.8976", "5.8905.8975", "3.8903.8974", "1.8901.8972", "1.101.8971", "29.29.100", "29.29.99")

If YYYY = 2017 Then A = Array(5780800, "28.8828.8898", "27.8827.8897", "28.8828.8899", "26.8826.8897", "26.8826.8896", "24.8824.8895", "23.8823.8894", "22.8822.8892", "20.20.8891", "20.20.90", "18.18.89", "18.18.88")

If YYYY = 2018 Then A = Array(5780800, "17.8817.8887", "16.8816.8886", "17.8817.8888", "16.8816.8886", "15.8815.8886", "14.8814.8884", "13.8813.8884", "11.8811.8882", "10.10.8880", "9.9.80", "8.8.78", "7.7.78")

If YYYY = 2019 Then A = Array(5780800, "6.8806.8876", "5.8805.8875", "7.8807.8877", "5.8805.8876", "5.8805.8875", "3.8803.8874", "3.8803.8873", "30.-70.8801.8872", "29.-71.-1", "28.-72.-1", "27.-73.-3", "26.-74.-3")

If YYYY = 2020 Then A = Array(5780800, "25.8725.8795", "24.8724.8794", "24.8724.8795", "23.8723.8793", "23.8723.8793", "21.8721.8792", "21.8721.8791", "19.-81.8790", "17.-83.-12", "17.-83.-13", "15.-85.-14", "15.-85.-15")

If YYYY = 2021 Then A = Array(5780800, "13.8713.8784", "12.8712.8782", "13.8713.8784", "12.8712.8782", "12.8712.8782", "10.8710.8781", "10.8710.8780", "8.-92.8779", "7.-93.-23", "6.-94.-23", "5.-95.-25", "4.-96.-25")

If YYYY = 2022 Then A = Array(5780800, "3.8703.8773", "1.8701.8772", "3.8703.8773", "1.8701.8772", "1.8701.8771", "29.8629.8699", "29.-171.8699", "27.-173.-102", "26.-174.-104", "25.-175.-104", "24.-176.-106", "24.-176.-106")

If YYYY = 2023 Then A = Array(5780800, "22.8622.8693", "20.8620.8691", "22.8622.8692", "20.8620.8691", "20.8620.8690", "18.8618.8689", "18.-182.8688", "16.-184.-113", "15.-185.-115", "15.-185.-115", "14.-186.-116", "13.-187.-116")

If YYYY = 2024 Then A = Array(5780800, "12.8612.8682", "10.8610.8681", "10.8610.8681", "9.8609.8679", "8.8608.8679", "6.8606.8677", "6.-194.8676", "4.-196.-125", "3.-197.-127", "3.-197.-127", "2.-198.-128", "1.-199.-128")

If YYYY = 2025 Then A = Array(5780800, "30.8530.8600", "29.8600.8599", "29.8529.8600", "28.8528.8598", "27.8527.8598", "25.-275.8596", "25.-275.-205", "23.-277.-206", "22.-278.-208", "22.-278.-208", "21.-279.-209", "20.-280.-209")

If YYYY = 2026 Then A = Array(5780800, "19.8519.8589", "17.8517.8588", "19.8519.8589", "17.8517.8588", "17.8517.8587", "15.-285.8586", "14.-286.-215", "13.-287.-217", "11.-289.-218", "11.-289.-219", "10.-290.-220", "9.-291.-220")

K = Split(A(MM), ".")

If Val(DD) > Val(K(0)) Then S = Val(K(1)) Else S = Val(K(2))

Hi = Val(YYYY & Format(MM, "00") & Format(DD, "00")) - A(0) - S

Hi = DateValue(Left(Hi, 4) & "," & Right(Left(Hi, 6), 2) & "," & Right(Hi, 2))

End Function

وفي أمر زر التحويل ضع الكود التالي

كود :

Private Sub Command1_Click()

Text1.Text = Hi(1, 2, 2015)

End Sub

تقبلواا تحياااااتي , ودعواتكم

منتدى فيجوال بيسك لكل العرب | منتدى المبرمجين العرب

Top GreaT