الى محبي VB6 تحويل التاريخ الى الهجري مباشرة وصحيح بإذن الله

كود :

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