البحث في الموقع

السلام عليكم اريد اظافة دالة ماكرو في دوال ايكسل كله حيث تصبح تعمل مثل دوال (f(x حتى لو تم غلق الجهاز الكمبيوتر وفتحه تعمل هذه الدالة والدالة التي اريد اضافتها هي عبارة عن ماكرو حيث تبقى تعمل هذه الدالة بصفة دائمة مثل دوال ايكسل( f(x دالة ماكرو هي Public Function Zaki(num_entry) Dim LE Dim PT Dim iVal Dim fFrac Dim cDigit Dim cFrac Dim result LE = " دينارًا جزائريًا " PT = " سنتيمًا " iVal = Int(num_entry) cDigit = Digit_Translator(iVal) fFrac = Val(Right(Format(num_entry, "000000000000.00"), 2)) cFrac = Digit_Translator(fFrac) If cDigit <> "" And fFrac > 0 Then result = cDigit & LE & " و " & cFrac & PT If cDigit <> "" And fFrac = 0 Then result = cDigit & LE If cDigit = "" And fFrac <> 0 Then result = cFrac & PT Monitize = result End Function Private Function Digit_Translator(X) Dim n Dim c Dim c1 Dim Digit1 Dim c2 Dim Digit2 Dim c3 Dim Digit3 Dim c4 Dim Digit4 Dim c5 Dim Digit5 Dim c6 Dim Digit6 n = Int(X) c = Format(n, "000000000000") c1 = Val(Mid(c, 12, 1)) Select Case c1 Case Is = 1: Digit1 = "واحد" Case Is = 2: Digit1 = "اثنان" Case Is = 3: Digit1 = "ثلاث" Case Is = 4: Digit1 = "اربع" Case Is = 5: Digit1 = "خمس" Case Is = 6: Digit1 = "ست" Case Is = 7: Digit1 = "سبع" Case Is = 8: Digit1 = "ثمان" Case Is = 9: Digit1 = "تسع" End Select c2 = Val(Mid(c, 11, 1)) Select Case c2 Case Is = 1: Digit2 = "عشر" Case Is = 2: Digit2 = "عشرون" Case Is = 3: Digit2 = "ثلاثون" Case Is = 4: Digit2 = "اربعون" Case Is = 5: Digit2 = "خمسون" Case Is = 6: Digit2 = "ستون" Case Is = 7: Digit2 = "سبعون" Case Is = 8: Digit2 = "ثمانون" Case Is = 9: Digit2 = "تسعون" End Select If Digit1 <> "" And c2 > 1 Then Digit2 = Digit1 + " و" + Digit2 If Digit2 = "" Then Digit2 = Digit1 If c1 = 0 And c2 = 1 Then Digit2 = Digit2 + "ة" If c1 = 1 And c2 = 1 Then Digit2 = "احدى عشر" If c1 = 2 And c2 = 1 Then Digit2 = "اثنتى عشر" If c1 > 2 And c2 = 1 Then Digit2 = Digit1 + " " + Digit2 c3 = Val(Mid(c, 10, 1)) Select Case c3 Case Is = 1: Digit3 = "مائة" Case Is = 2: Digit3 = "مئتان" Case Is > 2: Digit3 = Left(Digit_Translator(c3), Len(Digit_Translator(c3))) + "مائة" End Select If Digit3 <> "" And Digit2 <> "" Then Digit3 = Digit3 + " و" + Digit2 If Digit3 = "" Then Digit3 = Digit2 c4 = Val(Mid(c, 7, 3)) Select Case c4 Case Is = 1: Digit4 = "الف" Case Is = 2: Digit4 = "الفان" Case 3 To 10: Digit4 = Digit_Translator(c4) + " آلاف" Case Is > 10: Digit4 = Digit_Translator(c4) + " الف" End Select If Digit4 <> "" And Digit3 <> "" Then Digit4 = Digit4 + " و" + Digit3 If Digit4 = "" Then Digit4 = Digit3 c5 = Val(Mid(c, 4, 3)) Select Case c5 Case Is = 1: Digit5 = "مليون" Case Is = 2: Digit5 = "مليونان" Case 3 To 10: Digit5 = Digit_Translator(c5) + " ملايين" Case Is > 10: Digit5 = Digit_Translator(c5) + " مليونا" End Select If Digit5 <> "" And Digit4 <> "" Then Digit5 = Digit5 + " و" + Digit4 If Digit5 = "" Then Digit5 = Digit4 c6 = Val(Mid(c, 1, 3)) Select Case c6 Case Is = 1: Digit6 = "مليار" Case Is = 2: Digit6 = "ملياران" Case Is > 2: Digit6 = Digit_Translator(c6) + " مليارات" End Select If Digit6 <> "" And Digit5 <> "" Then Digit6 = Digit6 + " و" + Digit5 If Digit6 = "" Then Digit6 = Digit5 Digit_Translator = Digit6 End Function