اظافة دالة ماكرو مع دوال ايكسل( f(x بصفة دائمة

[زاكي بوشلاغم]

السلام عليكم اريد  اظافة  دالة  ماكرو  في دوال   ايكسل   كله  حيث تصبح  تعمل مثل  دوال (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

تم تعديل سبتمبر 12, 2015 بواسطه زاكي بوشلاغم
كيفية اظافة ملف

[زاكي بوشلاغم]

هل  من  مجيب

[زاكي بوشلاغم]

هل من مجيب