modUmAlQura.bas

Attribute VB_Name = "modUmAlQura"
'
'   UmAlQura mod For VBA
'   version 1.0.3
'   @copyright (c) Saeed Hubaishan <https://www.msofficeword.net> <https://www.salafitech.net>
'   @license LGPL, GPL-2
'
'
'

Private umData As Variant
Private umData2 As Variant
Const umStartYear As Integer = 1318
Const umEndYear As Integer = 1500
Const umStartMd As Integer = 121
Const umMidMd As Long = 29179
Const umEndMd As Long = 64970
Const UBumData As Integer = 984
Function get_umalquradata()

    umData = Array(121, 150, 180, 209, 239, 268, 298, 328, 358, 387, 417, 446, 475, 505, 534, 563, 593, 622, 652, 682, 712, 741, 771, 801, 830, 859, 889, 918, 947, 977, 1006, 1036, 1066, 1095, 1125, 1155, 1185, 1214, 1243, 1273, 1302, 1331, 1361, 1390, 1420, 1449, 1479, 1509, 1539, 1568, 1598, 1627, 1657, 1686, 1715, 1745, 1774, 1804, 1833, 1863, 1893, 1922, 1952, 1982, 2011, 2041, 2070, 2099, 2129, 2158, 2188, 2217, 2247, 2276, 2306, 2336, 2365, 2395, 2425, 2454, 2483, 2513, 2542, 2572, 2601, 2631, 2660, 2690, 2719, 2749, 2779, 2808, 2838, 2867, 2897, 2926, 2956, 2985, 3015, 3044, 3074, 3103, 3133, 3162, 3192, 3222, 3251, 3281, 3311, 3340, 3369, 3399, 3428, 3457, 3487, 3516, 3546, 3576, 3606, 3635, _
        3665, 3695, 3724, 3753, 3783, 3812, 3841, 3871, 3900, 3930, 3960, 3989, 4019, 4049, 4079, 4108, 4137, 4167, 4196, 4225, 4255, 4284, 4314, 4343, 4373, 4403, 4433, 4462, 4492, 4521, 4551, 4580, 4609, 4639, 4668, 4698, 4727, 4757, 4787, 4817, 4846, 4876, 4905, 4935, 4964, 4993, 5023, 5052, 5082, 5111, 5141, 5171, 5200, 5230, 5260, 5289, 5319, 5348, 5377, 5407, 5436, 5466, 5495, 5525, 5554, 5584, 5614, 5643, 5673, 5702, 5732, 5761, 5791, 5820, 5850, 5879, 5909, 5938, 5968, 5997, 6027, 6057, 6086, 6116, 6145, 6175, 6204, 6234, 6263, 6293, 6322, 6352, 6381, 6411, 6440, 6470, 6500, 6529, 6559, 6588, 6618, 6647, 6677, 6706, 6735, 6765, 6794, 6824, 6854, 6883, 6913, 6943, 6972, 7002, 7031, 7061, 7090, 7119, 7149, 7178, _
        7208, 7237, 7267, 7297, 7327, 7356, 7386, 7415, 7445, 7474, 7503, 7533, 7562, 7592, 7621, 7651, 7681, 7711, 7740, 7770, 7799, 7829, 7858, 7887, 7917, 7946, 7975, 8005, 8035, 8064, 8094, 8124, 8154, 8183, 8213, 8242, 8271, 8301, 8330, 8360, 8389, 8419, 8448, 8478, 8508, 8537, 8567, 8597, 8626, 8655, 8685, 8714, 8744, 8773, 8803, 8832, 8862, 8891, 8921, 8951, 8980, 9010, 9039, 9069, 9098, 9128, 9157, 9187, 9216, 9246, 9275, 9305, 9334, 9364, 9394, 9423, 9453, 9482, 9512, 9541, 9571, 9600, 9629, 9659, 9688, 9718, 9748, 9777, 9807, 9837, 9866, 9896, 9925, 9955, 9984, 10013, 10043, 10072, 10102, 10131, 10161, 10191, 10221, 10250, 10280, 10309, 10339, 10368, 10397, 10427, 10456, 10486, 10515, 10545, 10575, 10605, 10634, 10664, 10693, 10723, _
        10752, 10781, 10811, 10840, 10869, 10899, 10929, 10958, 10988, 11018, 11048, 11077, 11107, 11136, 11165, 11195, 11224, 11253, 11283, 11313, 11342, 11372, 11402, 11432, 11461, 11491, 11520, 11549, 11579, 11608, 11637, 11667, 11696, 11726, 11756, 11786, 11815, 11845, 11874, 11904, 11933, 11963, 11992, 12022, 12051, 12080, 12110, 12140, 12169, 12199, 12229, 12258, 12288, 12317, 12347, 12376, 12406, 12435, 12465, 12494, 12523, 12553, 12583, 12612, 12642, 12672, 12701, 12731, 12760, 12790, 12819, 12849, 12878, 12907, 12937, 12966, 12996, 13026, 13055, 13085, 13115, 13144, 13174, 13203, 13233, 13262, 13291, 13321, 13350, 13380, 13409, 13439, 13469, 13498, 13528, 13558, 13587, 13617, 13646, 13675, 13705, 13734, 13763, 13793, 13823, 13852, 13882, 13912, 13942, 13971, 14001, 14030, 14059, 14089, 14118, 14147, 14177, 14207, 14236, 14266, _
        14296, 14326, 14355, 14385, 14414, 14443, 14473, 14502, 14531, 14561, 14590, 14620, 14650, 14680, 14709, 14739, 14769, 14798, 14827, 14857, 14886, 14915, 14945, 14974, 15004, 15034, 15063, 15093, 15123, 15152, 15182, 15211, 15241, 15270, 15300, 15329, 15358, 15388, 15417, 15447, 15477, 15506, 15536, 15566, 15595, 15625, 15654, 15684, 15713, 15742, 15772, 15801, 15831, 15860, 15890, 15920, 15949, 15979, 16009, 16038, 16068, 16097, 16127, 16156, 16185, 16215, 16244, 16274, 16303, 16333, 16363, 16392, 16422, 16452, 16481, 16511, 16540, 16569, 16599, 16628, 16658, 16687, 16717, 16746, 16776, 16806, 16836, 16865, 16895, 16924, 16953, 16983, 17012, 17041, 17071, 17100, 17130, 17160, 17190, 17220, 17249, 17279, 17308, 17337, 17367, 17396, 17425, 17455, 17484, 17514, 17544, 17574, 17603, 17633, 17663, 17692, 17721, 17751, 17780, 17809, _
        17839, 17868, 17898, 17928, 17957, 17987, 18017, 18046, 18076, 18105, 18135, 18164, 18193, 18223, 18252, 18282, 18311, 18341, 18371, 18401, 18430, 18460, 18489, 18519, 18548, 18577, 18607, 18636, 18666, 18695, 18725, 18755, 18784, 18814, 18843, 18873, 18903, 18932, 18962, 18991, 19020, 19050, 19079, 19109, 19138, 19168, 19197, 19227, 19257, 19286, 19316, 19346, 19375, 19405, 19434, 19463, 19493, 19522, 19552, 19581, 19611, 19641, 19670, 19700, 19730, 19759, 19789, 19818, 19847, 19877, 19906, 19935, 19965, 19995, 20024, 20054, 20084, 20114, 20143, 20173, 20202, 20231, 20261, 20290, 20319, 20349, 20378, 20408, 20438, 20468, 20497, 20527, 20557, 20586, 20615, 20645, 20674, 20703, 20733, 20762, 20792, 20822, 20851, 20881, 20911, 20940, 20970, 20999, 21029, 21058, 21087, 21117, 21146, 21176, 21205, 21235, 21265, 21295, 21324, 21354, _
        21383, 21413, 21442, 21471, 21501, 21530, 21560, 21589, 21619, 21649, 21678, 21708, 21738, 21767, 21797, 21826, 21855, 21885, 21914, 21944, 21973, 22003, 22032, 22062, 22092, 22121, 22151, 22180, 22210, 22239, 22269, 22298, 22328, 22357, 22387, 22416, 22446, 22475, 22505, 22535, 22564, 22594, 22623, 22653, 22683, 22712, 22741, 22771, 22800, 22829, 22859, 22889, 22918, 22948, 22978, 23007, 23037, 23067, 23096, 23125, 23155, 23184, 23213, 23243, 23272, 23302, 23332, 23362, 23391, 23421, 23451, 23480, 23509, 23539, 23568, 23597, 23627, 23656, 23686, 23716, 23745, 23775, 23805, 23835, 23864, 23893, 23923, 23952, 23981, 24011, 24040, 24070, 24099, 24129, 24159, 24189, 24218, 24248, 24277, 24307, 24336, 24365, 24395, 24424, 24454, 24483, 24513, 24543, 24572, 24602, 24632, 24661, 24691, 24720, 24749, 24779, 24808, 24838, 24867, 24897, _
        24926, 24956, 24986, 25015, 25045, 25074, 25104, 25133, 25163, 25192, 25222, 25251, 25281, 25310, 25340, 25369, 25399, 25429, 25458, 25488, 25517, 25547, 25576, 25606, 25635, 25665, 25694, 25724, 25753, 25783, 25812, 25842, 25872, 25901, 25931, 25960, 25990, 26019, 26049, 26078, 26107, 26137, 26166, 26196, 26226, 26256, 26285, 26315, 26345, 26374, 26403, 26433, 26462, 26491, 26521, 26550, 26580, 26610, 26639, 26669, 26699, 26729, 26758, 26787, 26817, 26846, 26875, 26905, 26934, 26964, 26993, 27023, 27053, 27083, 27112, 27142, 27171, 27201, 27230, 27259, 27289, 27318, 27348, 27377, 27407, 27437, 27466, 27496, 27526, 27555, 27585, 27614, 27643, 27673, 27702, 27732, 27761, 27791, 27820, 27850, 27880, 27910, 27939, 27969, 27998, 28027, 28057, 28086, 28116, 28145, 28175, 28204, 28234, 28264, 28293, 28323, 28352, 28382, 28411, 28441, _
        28470, 28500, 28529, 28559, 28588, 28618, 28647, 28677, 28707, 28736, 28766, 28795, 28825, 28854, 28884, 28913, 28943, 28972, 29002, 29031, 29061, 29090, 29120, 29150, 29179)
    
    umData2 = Array(29179, 29209, 29238, 29268, 29297, 29327, 29356, 29385, 29415, 29444, 29474, 29504, 29533, 29563, 29593, 29622, 29652, 29681, 29711, 29740, 29769, 29799, 29828, 29858, 29887, 29917, 29947, 29977, 30006, 30036, 30065, 30095, 30124, 30153, 30183, 30212, 30242, 30271, 30301, 30331, 30361, 30390, 30420, 30449, 30479, 30508, 30537, 30567, 30596, 30625, 30655, 30685, 30714, 30744, 30774, 30804, 30833, 30863, 30892, 30921, 30951, 30980, 31009, 31039, 31069, 31098, 31128, 31158, 31187, 31217, 31246, 31276, 31305, 31335, 31364, 31394, 31423, 31453, 31482, 31512, 31541, 31571, 31601, 31630, 31660, 31689, 31719, 31748, 31778, 31807, 31837, 31866, 31896, 31925, 31955, 31984, 32014, 32044, 32073, 32103, 32132, 32162, 32191, 32221, 32250, 32279, 32309, 32338, 32368, 32398, 32427, 32457, 32487, 32516, 32546, 32575, 32605, 32634, 32663, 32693, 32722, _
        32752, 32781, 32811, 32841, 32871, 32900, 32930, 32959, 32989, 33018, 33047, 33077, 33106, 33136, 33165, 33195, 33225, 33254, 33284, 33314, 33343, 33373, 33402, 33431, 33461, 33490, 33519, 33549, 33579, 33608, 33638, 33668, 33698, 33727, 33757, 33786, 33815, 33845, 33874, 33903, 33933, 33963, 33992, 34022, 34052, 34081, 34111, 34141, 34170, 34199, 34229, 34258, 34287, 34317, 34346, 34376, 34406, 34436, 34465, 34495, 34524, 34554, 34583, 34613, 34642, 34671, 34701, 34730, 34760, 34790, 34819, 34849, 34879, 34908, 34938, 34967, 34997, 35026, 35056, 35085, 35114, 35144, 35173, 35203, 35233, 35262, 35292, 35321, 35351, 35381, 35410, 35440, 35469, 35499, 35528, 35557, 35587, 35616, 35646, 35675, 35705, 35735, 35765, 35794, 35824, 35853, 35883, 35912, 35941, 35971, 36000, 36030, 36059, 36089, 36119, 36148, 36178, 36208, 36237, 36267, _
        36296, 36326, 36355, 36384, 36414, 36443, 36473, 36503, 36533, 36563, 36592, 36622, 36651, 36680, 36710, 36739, 36768, 36797, 36827, 36857, 36887, 36917, 36946, 36976, 37006, 37035, 37064, 37094, 37123, 37152, 37181, 37211, 37241, 37271, 37300, 37330, 37360, 37389, 37419, 37448, 37478, 37507, 37536, 37566, 37595, 37625, 37654, 37684, 37714, 37743, 37773, 37803, 37832, 37862, 37891, 37920, 37950, 37979, 38009, 38038, 38068, 38097, 38127, 38157, 38186, 38216, 38245, 38275, 38305, 38334, 38364, 38393, 38422, 38452, 38481, 38511, 38540, 38570, 38600, 38629, 38659, 38689, 38718, 38748, 38777, 38806, 38836, 38865, 38895, 38924, 38954, 38984, 39013, 39043, 39073, 39102, 39132, 39161, 39190, 39220, 39249, 39278, 39308, 39338, 39368, 39397, 39427, 39457, 39486, 39516, 39545, 39574, 39604, 39633, 39662, 39692, 39722, 39751, 39781, 39811, _
        39840, 39870, 39900, 39929, 39958, 39988, 40017, 40047, 40076, 40106, 40135, 40165, 40194, 40224, 40254, 40283, 40313, 40342, 40372, 40401, 40431, 40460, 40489, 40519, 40548, 40578, 40608, 40638, 40667, 40697, 40726, 40756, 40785, 40815, 40844, 40873, 40903, 40932, 40962, 40992, 41021, 41051, 41081, 41110, 41140, 41169, 41199, 41228, 41257, 41287, 41316, 41346, 41375, 41405, 41435, 41464, 41494, 41524, 41553, 41582, 41612, 41641, 41671, 41700, 41730, 41759, 41789, 41818, 41848, 41878, 41907, 41937, 41966, 41996, 42025, 42055, 42084, 42114, 42143, 42173, 42202, 42232, 42261, 42291, 42321, 42350, 42380, 42410, 42439, 42468, 42498, 42527, 42557, 42586, 42615, 42645, 42675, 42704, 42734, 42764, 42794, 42823, 42852, 42882, 42911, 42940, 42970, 42999, 43029, 43058, 43088, 43118, 43148, 43177, 43207, 43236, 43266, 43295, 43324, 43354, _
        43383, 43413, 43442, 43472, 43502, 43532, 43561, 43591, 43620, 43650, 43679, 43708, 43738, 43767, 43797, 43826, 43856, 43886, 43915, 43945, 43975, 44004, 44034, 44063, 44092, 44122, 44151, 44181, 44210, 44240, 44269, 44299, 44329, 44358, 44388, 44417, 44447, 44476, 44506, 44535, 44565, 44594, 44624, 44653, 44683, 44712, 44742, 44772, 44801, 44831, 44860, 44890, 44920, 44949, 44978, 45008, 45037, 45067, 45096, 45126, 45155, 45185, 45215, 45245, 45274, 45304, 45333, 45362, 45392, 45421, 45450, 45480, 45509, 45539, 45569, 45599, 45628, 45658, 45688, 45717, 45746, 45776, 45805, 45834, 45864, 45893, 45923, 45953, 45983, 46012, 46042, 46071, 46101, 46130, 46160, 46189, 46218, 46248, 46277, 46307, 46337, 46366, 46396, 46426, 46455, 46485, 46514, 46544, 46573, 46602, 46632, 46661, 46691, 46720, 46750, 46780, 46809, 46839, 46869, 46898, _
        46928, 46957, 46987, 47016, 47045, 47075, 47104, 47134, 47163, 47193, 47223, 47252, 47282, 47312, 47341, 47371, 47400, 47429, 47459, 47488, 47518, 47547, 47577, 47606, 47636, 47666, 47696, 47725, 47755, 47784, 47813, 47843, 47872, 47902, 47931, 47961, 47990, 48020, 48050, 48080, 48109, 48138, 48168, 48197, 48227, 48256, 48286, 48315, 48344, 48374, 48404, 48434, 48463, 48493, 48522, 48552, 48581, 48611, 48640, 48670, 48699, 48728, 48758, 48788, 48817, 48847, 48876, 48906, 48936, 48965, 48995, 49024, 49054, 49083, 49112, 49142, 49171, 49201, 49230, 49260, 49290, 49320, 49349, 49379, 49408, 49438, 49467, 49496, 49526, 49555, 49584, 49614, 49644, 49673, 49703, 49733, 49763, 49792, 49822, 49851, 49880, 49910, 49939, 49968, 49998, 50028, 50057, 50087, 50117, 50147, 50176, 50206, 50235, 50264, 50294, 50323, 50352, 50382, 50412, 50441, _
        50471, 50501, 50530, 50560, 50589, 50619, 50648, 50678, 50707, 50736, 50766, 50796, 50825, 50855, 50884, 50914, 50944, 50973, 51003, 51032, 51062, 51091, 51121, 51150, 51180, 51209, 51239, 51268, 51298, 51327, 51357, 51386, 51416, 51446, 51475, 51505, 51534, 51564, 51593, 51622, 51652, 51681, 51711, 51741, 51770, 51800, 51830, 51859, 51889, 51918, 51948, 51977, 52006, 52036, 52065, 52095, 52124, 52154, 52184, 52214, 52243, 52273, 52302, 52332, 52361, 52390, 52420, 52449, 52478, 52508, 52538, 52568, 52598, 52627, 52657, 52686, 52716, 52745, 52774, 52804, 52833, 52863, 52892, 52922, 52952, 52981, 53011, 53041, 53070, 53100, 53129, 53158, 53188, 53217, 53247, 53276, 53306, 53335, 53365, 53395, 53424, 53454, 53483, 53513, 53542, 53572, 53601, 53631, 53660, 53689, 53719, 53749, 53778, 53808, 53838, 53867, 53897, 53927, 53956, 53985, _
        54015, 54044, 54073, 54103, 54133, 54162, 54192, 54221, 54251, 54281, 54311, 54340, 54369, 54399, 54428, 54457, 54487, 54516, 54546, 54576, 54605, 54635, 54665, 54694, 54724, 54753, 54783, 54812, 54842, 54871, 54900, 54930, 54959, 54989, 55019, 55048, 55078, 55107, 55137, 55167, 55196, 55226, 55255, 55284, 55314, 55343, 55373, 55402, 55432, 55462, 55491, 55521, 55551, 55580, 55610, 55639, 55668, 55698, 55727, 55757, 55786, 55816, 55845, 55875, 55905, 55935, 55964, 55994, 56023, 56052, 56082, 56111, 56140, 56170, 56199, 56229, 56259, 56289, 56318, 56348, 56378, 56407, 56436, 56466, 56495, 56524, 56554, 56583, 56613, 56643, 56672, 56702, 56732, 56762, 56791, 56820, 56850, 56879, 56908, 56938, 56967, 56997, 57027, 57056, 57086, 57116, 57145, 57175, 57204, 57234, 57263, 57292, 57322, 57351, 57381, 57410, 57440, 57470, 57499, 57529, _
        57558, 57588, 57618, 57647, 57676, 57706, 57735, 57765, 57794, 57824, 57853, 57883, 57912, 57942, 57972, 58001, 58031, 58061, 58090, 58120, 58149, 58178, 58208, 58237, 58267, 58296, 58326, 58356, 58385, 58415, 58445, 58474, 58504, 58533, 58562, 58592, 58621, 58650, 58680, 58710, 58739, 58769, 58799, 58829, 58858, 58888, 58917, 58946, 58976, 59005, 59034, 59064, 59094, 59123, 59153, 59183, 59212, 59242, 59272, 59301, 59330, 59360, 59389, 59418, 59448, 59478, 59507, 59537, 59566, 59596, 59626, 59656, 59685, 59714, 59744, 59773, 59803, 59832, 59862, 59891, 59921, 59950, 59980, 60010, 60039, 60069, 60098, 60128, 60157, 60187, 60216, 60245, 60275, 60304, 60334, 60364, 60393, 60423, 60453, 60482, 60512, 60541, 60571, 60600, 60629, 60659, 60688, 60718, 60747, 60777, 60807, 60837, 60866, 60896, 60925, 60955, 60984, 61013, 61043, 61072, _
        61102, 61131, 61161, 61191, 61220, 61250, 61280, 61309, 61339, 61368, 61397, 61427, 61456, 61486, 61515, 61545, 61574, 61604, 61634, 61663, 61693, 61722, 61752, 61782, 61811, 61840, 61870, 61899, 61929, 61958, 61988, 62017, 62047, 62077, 62106, 62136, 62166, 62195, 62224, 62254, 62283, 62313, 62342, 62371, 62401, 62431, 62460, 62490, 62520, 62550, 62579, 62608, 62638, 62667, 62696, 62726, 62755, 62785, 62814, 62844, 62874, 62904, 62933, 62963, 62992, 63022, 63051, 63080, 63110, 63139, 63169, 63198, 63228, 63258, 63288, 63317, 63347, 63376, 63406, 63435, 63464, 63494, 63523, 63553, 63582, 63612, 63642, 63671, 63701, 63731, 63760, 63789, 63819, 63848, 63878, 63907, 63937, 63966, 63996, 64025, 64055, 64085, 64114, 64144, 64173, 64203, 64232, 64262, 64291, 64321, 64350, 64380, 64409, 64439, 64468, 64498, 64527, 64557, 64587, 64616, _
        64646, 64676, 64705, 64734, 64764, 64793, 64822, 64852, 64881, 64911, 64941, 64970)
End Function


Public Function date2UQ(theDate As Date, ByRef hy, ByRef hm, ByRef hd, ByRef hz)
    Dim md As Long
    Dim startI As Long
    Dim oldCalendar As VbCalendar
    md = Int(theDate)
    If (md >= umStartMd And md <= umEndMd) Then
        If (IsEmpty(umData)) Then
            get_umalquradata
        End If
        
        
        If md < umMidMd Then
            umdata_count = UBound(umData)
            For i = CLng((md - umStartMd) / 29.53056) To umdata_count
                If umData(i) > (md) Then Exit For
            Next
            hd = md - umData(i - 1) + 1
            ii = Int((i - 1) / 12)
            hz = md - umData(12 * ii) + 1
        Else
            umdata_count = UBound(umData2)
        
            startI = CLng((md - umMidMd) / 29.53056)
            For i = startI To umdata_count
                If umData2(i) > (md) Then Exit For
            Next
            hd = md - umData2(i - 1) + 1
            i = i + UBumData
            ii = Int((i - 1) / 12)
            hz = md - umData2((12 * ii) - UBumData) + 1
        End If
        hy = umStartYear + ii
        hm = i - 12 * ii

    Else
        oldCalendar = Calendar
        Calendar = vbCalHijri
        hy = DatePart("yyyy", theDate)
        hm = DatePart("m", theDate)
        hd = DatePart("d", theDate)
        hz = DatePart("y", theDate)
        Calendar = oldCalendar
    End If

End Function
Function UQDateSerial(theYear, theMonth, theDay) As Date
    Dim md As Long
    theYear = Int(theYear)
    theMonth = Int(theMonth)
    theDay = Int(theDay)
    
    If (theYear >= umStartYear And theYear <= umEndYear) Then
        If (IsEmpty(umData)) Then
            get_umalquradata
        End If
        ii = theYear - umStartYear
        i = theMonth + (12 * ii)
        If i > UBumData Then
            md = theDay + umData2(i - UBumData - 1) - 1
        
        Else
            md = theDay + umData(i - 1) - 1
        End If
    Else
        md = 0
    End If
    UQDateSerial = CDate(md)

End Function
Function UQMonth(theDate)
    If IsNull(theDate) Then
        UQMonth = Null
    Else
        date2UQ CDate(theDate), hy, hm, hd, hz
        UQMonth = hm
    End If
End Function
Function UQYear(theDate)
    If IsNull(theDate) Then
        UQYear = Null
    Else
        date2UQ CDate(theDate), hy, hm, hd, hz
        UQYear = hy
    End If
End Function
Function UQDay(theDate)
    If IsNull(theDate) Then
        UQDay = Null
    Else
        date2UQ CDate(theDate), hy, hm, hd, hz
        UQDay = hd
    End If
End Function
Function UQDateAdd(interval, number, theDate As Date) As Date
    Dim hy As Long, hm As Integer, hd As Integer, hz As Integer
    Dim myDate As Date
    number = Int(number)
    
    Select Case LCase(interval)
        Case "yyyy"
            date2UQ theDate, hy, hm, hd, hz
           myDate = UQDateSerial(hy + number, hm, hd)
        Case "q"
           date2UQ theDate, hy, hm, hd, hz
           myDate = UQDateSerial(hy, hm + (number * 3), hd)
        Case "m"
           date2UQ theDate, hy, hm, hd, hz
           myDate = UQDateSerial(hy, hm + number, hd)
        Case Else
            myDate = DateAdd(interval, number, theDate)
    End Select
    UQDateAdd = myDate
               
    
    
End Function
Function UQDateDiff(interval As String, date1 As Date, date2 As Date, Optional firstdayofweek As VbDayOfWeek = vbSunday, Optional firstweekofyear As VbFirstWeekOfYear = vbFirstJan1) As Variant
    Dim hy1 As Long, hm1 As Integer, hd1 As Integer, hz1 As Integer
    Dim hy2 As Long, hm2 As Integer, hd2 As Integer, hz2 As Integer
    Dim myRet As Long
    
    Select Case LCase(interval)
        Case "yyyy"
            date2UQ date1, hy1, hm1, hd1, hz1
            date2UQ date2, hy2, hm2, hd2, hz2
            myRet = hy2 - hy1
        Case "m"
            date2UQ date1, hy1, hm1, hd1, hz1
            date2UQ date2, hy2, hm2, hd2, hz2
            myRet = (hy2 * 12) + hm2 - (hy1 * 12) - hm1
        Case "q"
            date2UQ date1, hy1, hm1, hd1, hz1
            date2UQ date2, hy2, hm2, hd2, hz2
            myRet = (hy2 * 4) + ((hm2 + 2) \ 3) - (hy1 * 4) - ((hm1 + 2) \ 3)
        
       
        Case Else
            myRet = DateDiff(interval, date1, date2, firstdayofweek, firstweekofyear)
    End Select
    UQDateDiff = myRet
    
End Function
Function UQDatePart(interval As String, theDate As Date, Optional firstdayofweek As VbDayOfWeek = vbSunday, Optional firstweekofyear As VbFirstWeekOfYear = vbFirstJan1) As Variant
    Dim myRet As Integer
    Dim hy As Long, hm As Integer, hd As Integer, hz As Integer
    If Not (interval = "w" Or inerval = "h" Or interval = "n" Or interval = "s") Then
        date2UQ theDate, hy, hm, hd, hz
    End If
    
    Select Case interval
        Case "yyyy"
            myRet = hy
        Case "q"
            myRet = ((hm + 2) \ 3)
        Case "m"
            myRet = hm
        Case "y"
            myRet = hz
        Case "d"
            myRet = hd
        Case Else
            myRet = DatePart(interval, theDate, firstdayofweek, firstweekofyear)
    End Select
    UQDatePart = myRet
End Function
Function UQFormat(ByVal theDate, ByVal theFormat) As String
    Dim hy, hm, hd, hz
    Dim n As Integer, m As Integer, strF As String, HCalled As Integer
    Dim myRet As String
    Dim oldCalendar As VbCalendar

    date2UQ CDate(theDate), hy, hm, hd, hz
    theFormat = Trim(theFormat)
    If theFormat = "Short Date" Then
        theFormat = "dd/mm/yyyy"
    ElseIf theFormat = "Long Date" Then
        theFormat = "dddd, dd mmmm, yyyy"
    ElseIf theFormat = "Medium Date" Then
        theFormat = "dd mmmm, yyyy"
    End If
    n = 1
    
    
    Do While n <= Len(theFormat)
        strF = Mid(theFormat, n, 1)
        m = 1
        Do While Mid(theFormat, n + m, 1) = strF
            m = m + 1
        Loop
        strF = Mid(theFormat, n, m)
        
        Select Case strF
            Case "d"
                myRet = myRet & hd
            Case "dd"
                    myRet = myRet & LeadZero(hd)
            Case "ddd"
                myRet = myRet & WeekdayName(Weekday(theDate, vbUseSystemDayOfWeek), True, vbUseSystemDayOfWeek)
            Case "dddd"
                myRet = myRet & WeekdayName(Weekday(theDate, vbUseSystemDayOfWeek), False, vbUseSystemDayOfWeek)
            Case "w"
                myRet = myRet & Weekday(theDate, vbSunday)
            Case "ddddd"
                myRet = myRet & LeadZero(hd) & "/" & LeadZero(hm) & "/" & LeadZero(hy, 4)
            Case "dddddd"
                oldCalendar = Calendar
                Calendar = vbCalHijri
                myRet = myRet & WeekdayName(Weekday(theDate, vbUseSystemDayOfWeek), False, vbUseSystemDayOfWeek) & ", " & LeadZero(hd) & " " & MonthName(hm) & ", " & LeadZero(hy, 4)
                Calendar = oldCalendar
            Case "m"
                If HCalled > 0 And HCalled + 3 >= n Then
                    myRet = myRet & "m"
                Else
                    myRet = myRet & hm
                End If
            Case "mm"
                If HCalled > 0 And HCalled + 3 >= n Then
                    myRet = myRet & "m"
                Else
                    myRet = myRet & LeadZero(hm)
                End If
            Case "mmm", "mmmm"
                oldCalendar = Calendar
                Calendar = vbCalHijri
                myRet = myRet & MonthName(hm)
                Calendar = oldCalendar
            Case "q"
                myRet = myRet & ((hm + 2) \ 3)
            Case "y"
                myRet = myRet & hz
            Case "yy"
                myRet = myRet & Right(hy, 2)
            Case "yyyy"
                myRet = myRet & hy
            Case "h", "hh", "ttttt"
                myRet = myRet & Format(theDate, Mid(theFormat, n))
                n = Len(theFormat)
            Case Else
                myRet = myRet & strF
        End Select
        n = n + m
    Loop
    UQFormat = myRet
End Function
Private Function LeadZero(thenumber, Optional digits As Integer = 2)
    myRet = CStr(thenumber)
    If digits > Len(myRet) Then
        LeadZero = String(digits - Len(myRet), "0") & myRet
    Else
        LeadZero = myRet
    End If
End Function