لاضافة ماكرو بالورود او بالاكسل اليك الخطوات التالية :
1- ادوات ثم ماكرو ثم محرر فيجوال بيسك وبعد فتح المحرر ارجع الى ادوات ثم اختر انشاء ماكرو جديد باي اسم فيرجع بك الى المحرر حدد جميع النص المنشأ الياً بواسطة المحرر واستبدله بالكود المراد استخدامه .
2- ثم لاستخدام الكود المضاف ستجد هناك اختلاف بين الورد والاكسل حيث انه بالاكسل ستستدعي الكود من خلال الدالة او الاجراء الرئسي فيه وذلك بشريط الصيغ مثلا لاستدعاء كود التفقيط بشريط الصيع اتبع الاتي: 

1- اكتب اي رقم بالخانة : A1
ب- ثم انزل للخانة التي تليها ولصق النص التالي بشريط الصيغ فتظهر معك النتيجة
=ToWordsArb(A1)

3- اما عن طريق الوورد فتوجه ايضا الى ادوات ثم اطلب تشغيل ماكرو وستجد اسم الماكرو او الاجراء فقم باختياره .


-----------<( بداية الكود)>-----------

 Function ToWordsArb(Num As String) As String
'
' ?C???1 ?C???
' C??C??? ???? ?05/10/2006 E?C??E ? ASMSA
'

'
   Dim S1 As String, S2 As String, S3 As String, Tmp As String, X As String
   Dim L As Integer, T As Integer, R As Integer, T_ As String
   Const S As String = " ": Const O As String = " ? "
   T_ = "C?C?"
   
   
   'Fill Array'''''''''''''''''''(1 to 9)'''''''''''''''''''''
   Dim AN(0 To 9) As String 'Data for conversion
   AN(1) = "?C?I": AN(2) = "CE?C?": AN(3) = "E?CEE"
   AN(4) = "C?E?E": AN(5) = "I??E": AN(6) = "?EE"
   AN(7) = "?E?E": AN(8) = "E?C??E": AN(9) = "E??E"
   ''''''''''''''''''''(11 to 19 )'''''''''''''''''''''''''''''
   Dim BN(0 To 9) As String
   BN(0) = "?O?E"
   BN(1) = "C?I ?O?": BN(2) = "CE?C ?O?": BN(3) = "E?CEE ?O?"
   BN(4) = "C?E? ?O?": BN(5) = "I??E ?O?": BN(6) = "?EE ?O?"
   BN(7) = "?E?E ?O?": BN(8) = "E?C??E ?O?": BN(9) = "E??E ?O?"
   ''''''''''''''''''''(10 to 90)'''''''''''''''''''''''''''''''''''
   Dim CN(0 To 9) As String
   CN(1) = "?O?E": CN(2) = "?O???": CN(3) = "E?CE??"
   CN(4) = "C?E???": CN(5) = "I????": CN(6) = "?E??"
   CN(7) = "?E???": CN(8) = "E?C???": CN(9) = "E????"
   ''''''''''''''''''''(100 to 900)'''''''''''''''''''''''''''''''''''
   Dim DN(0 To 9) As String
   DN(1) = "?C?E": DN(2) = "?C?E??": DN(3) = "E?CE ?C?E"
   DN(4) = "C?E? ?C?E": DN(5) = "I?? ?C?E": DN(6) = "?E ?C?E"
   DN(7) = "?E? ?C?E": DN(8) = "E?C? ?C?E": DN(9) = "E?? ?C?E"
   'ZEROs''''''''''''''''''''''''''''''
   AN(0) = "": BN(0) = "?O?E": CN(0) = "": DN(0) = ""
   'Make redey''''''''''''''''''''''''''''''

   L = Len(Num)

'''''''''''''''''''''''''''''''''Check Start: ''''''''''''''''''''''''''''''''''''''''''''
''ALL BY ORDER :'''''''''''''''''''''''''''''

Dim W As Collection, C As Integer, MM As String
Set W = New Collection
       'Split numbers to array
       For T = L To 1 Step -1
       MM = Mid(CStr(Num), T, 1)
       If IsNumeric(MM) Then W.Add MM
       Next T
'Exit if it Zero'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Num = Replace(Num, "|", ""): If Val(Num) = 0 Then X = "???": GoTo Ex '''
C = W.Count: L = C  'Very Important                                  '''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

   '1 Check''1 to 9
   If L = 1 Then X = AN(Val(Num)): GoTo Ex
   
   '2 Check'11-12-13....To: 19
   If L = 2 Then If Val(W.Item(2)) = 1 Then _
   X = BN(Val(W.Item(1))): GoTo Ex
   
   '2 Check'10-20-30....To: 90
   If L = 2 Then If Val(W.Item(1)) = 0 Then _
   X = CN(Val(W.Item(1))): GoTo Ex
   
    '3 Check'From 21 ....To: 90
   If L = 2 Then X = AN(Val(W.Item(1))) & O & CN(Val(W.Item(2))): GoTo Ex

Re_Check:
'3 Check' The Tow Frist Numbers of Large number:
   If Val(W.Item(2)) = "1" Then 'Elvenths(BN)
   X = BN(Val(Val(W.Item(1))))
   ElseIf Val(W.Item(1)) = "0" Then 'Tointeth(CN)
   X = CN(Val(Val(W.Item(2))))
   Else
   X = AN(Val(W.Item(1))) & O & CN(Val(W.Item(2)))  'From 21-67 ....To: 90
   End If
 
X = Zeros(W, X, 2)
   
'4 Check ' 12-31-41... to end'''

If L > 2 Then 'Hundreds(DN)
X = DN(Val(W.Item(3))) & O & X 'Hundreds & Numbers
If W.Item(1) = "0" And W.Item(2) = "0" Then X = DN(Val(W.Item(3))) 'Hundreds & Zeros

X = Zeros(W, X, 3)
End If
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If L = 4 Then ' Thawsend(1,000)''4 Numbers'''''''''''''''''''''''''''''''

   If Val(W.Item(4)) = 1 Then
   Tmp = "C??"
   ElseIf Val(W.Item(4)) = 2 Then
   Tmp = "C????"
   Else
   Tmp = "C?C?"
   End If
   
   If Tmp = "C?C?" Then X = AN(Val(W.Item(4))) & S & Tmp & O & X Else X = Tmp & O & X  'Thawsend & Numbers
   
   If W(2) = "0" & W(3) = "0" & W(4) = "0" Then _
   If Tmp = "C?C?" Then X = AN(Val(W.Item(1))) & S & Tmp Else X = Tmp 'Thawsend & Zeros
   
X = Zeros(W, X, 4)
End If
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'If L > 4 And L < 8 Then '10 Thawsend(10,000)''5 Numbers'''''''''''''''''''''''''''''''
If L > 4 Then ''___ OPEN IF ______________________________________________(L > 4)

TenThawsend: '10 Thawsend(10,000)''5 Numbers'''''''''''''''''''''''''''''''
Tmp = ""
If W(5) = "0" Then GoTo HoundredsThawsend 'Jump

   If Val(W.Item(5)) = 1 Then
   Tmp = "?O?E C?C?"
   ElseIf Val(W.Item(5)) = 2 Then
   Tmp = "?O??? C??"
   End If


       If W(4) = "0" Then '10.000
       If Val(W.Item(5)) = 1 Or Val(W.Item(5)) = 2 Then X = Tmp & O & X Else _
       T_ = "C??": X = CN(Val(W(5))) & S & T_ & O & X
       Else '11.000
       T_ = "C??"
       If W(5) = "1" Then X = BN(Val(W(4))) & S & T_ & O & X
       If W(5) <> "1" Then X = AN(Val(W(4))) & O & CN(Val(W(5))) & S & T_ & O & X
       End If
       
If L = 5 Then GoTo Ex '100 Thawsend(100,000)''6 Numbers''''''''''''''''''''''''''''''
HoundredsThawsend:

If W(6) = "0" Then GoTo Mileons 'Jump
X = Zeros(W, X, 5)

Tmp = "C??"

If W(5) = "0" And W(4) = "0" Then
X = DN(Val(W(6))) & S & Tmp & O & X
Else
   If W(5) = 0 Then
   If Val(W(6)) > 2 Then Tmp = "C?C?"
   If Val(W(5)) = 0 Then If Val(W(4)) > 2 Then Tmp = "C?C?" Else Tmp = "C??"
   X = DN(Val(W(6))) & O & AN(Val(W(4))) & S & Tmp & O & X 'tx here
   Else
   X = DN(Val(W(6))) & O & X
   End If
End If
X = Replace(X, "?C?E?? C??", "??E? C??")
X = Replace(X, " C?? C?? ", " C?? ")

If L < 7 Then GoTo Ex 'Milon(1000,000)''7 numbers'''''''''''''''''''''''''''''''
Mileons:

If Val(W.Item(7)) < 1 Then GoTo TenMileons 'Jump
If L > 7 Then If Val(W.Item(8)) <> 0 Then GoTo TenMileons 'Jump
If L > 8 Then If Val(W(9)) <> 0 Then GoTo TenMileons 'Jump

Tmp = "??C??"

   
   If Val(W.Item(7)) = 1 Then
   Tmp = "?????"
   ElseIf Val(W.Item(7)) = 2 Then
   Tmp = "???????"
   End If
   
X = Zeros(W, X, 6)
   
If Val(W.Item(7)) > 2 Then X = AN(Val(W(7))) & S & Tmp & O & X Else X = Tmp & O & X

If L < 8 Then GoTo Ex 'Milon(10,000,000)''8 numbers'''''''''''''''''''''''''''''''
TenMileons:
If L > 8 Then If Val(W(9)) <> 0 Or Val(W(8)) < 1 Then GoTo HoundredsMileons 'Jump

If Val(W(8)) = 1 Then Tmp = "??C??" Else Tmp = "?????"

X = Zeros(W, X, 6)
X = Zeros(W, X, 7)

   If Val(W(8)) = 1 Then 'Tenth Mileons:10,000,000
   If Val(W(7)) = 0 Then X = CN(Val(W(8))) & S & Tmp & O & X Else _
   Tmp = "?????": X = BN(Val(W(7))) & S & Tmp & O & X 'Elventh Mileons
   Else
   If Val(W(7)) = 0 Then X = CN(Val(W(8))) & S & Tmp & O & X Else _
    X = AN(Val(W(7))) & O & CN(Val(W(8))) & S & Tmp & O & X   '12,000,000
   End If

If L < 9 Then GoTo Ex 'Milon(100,000,000)''9 numbers'''''''''''''''''''''''''''''''
HoundredsMileons:
If L > 9 And Val(W(9)) < 1 Then GoTo Bileon

Tmp = "?????"
X = Zeros(W, X, 8)

   If Val(W(7)) = 0 And Val(W(8)) = 0 Then    '100,000,000
   X = DN(Val(W(9))) & S & Tmp & O & X 'Puer Houndreds Of Mileons
   Else '110,000,000
   '1- Houndreds Of Mileons & Elvenths : ..2- Else :Houndreds Of Mileons & Frist numbers
   If Val(W(8)) = 1 Then X = DN(Val(W(9))) & O & BN(Val(W(7))) & S & Tmp & O & X Else _
   X = DN(Val(W(9))) & O & AN(Val(W(7))) & S & O & CN(Val(W(8))) & S & Tmp & O & X
   End If
X = Replace(X, "?C?E?? ?????", "??E? ?????")

If L < 10 Then GoTo Ex 'Bileon(1,000,000,000)''10 numbers'''''''''''''''''''''''''''''''
Bileon:

If Val(W.Item(10)) < 1 Then GoTo Ten_Of_Bileons 'Jump
If L > 10 Then If Val(W.Item(11)) <> 0 Then GoTo Ten_Of_Bileons 'Jump
If L > 11 Then If Val(W(12)) <> 0 Then GoTo Ten_Of_Bileons 'Jump


Tmp = "E?C??"

   If Val(W.Item(10)) = 1 Then
   Tmp = "E????"
   ElseIf Val(W.Item(10)) = 2 Then
   Tmp = "E??????"
   End If
   
X = Zeros(W, X, 9)

If Val(W.Item(10)) > 2 Then X = AN(Val(W(10))) & S & Tmp & O & X Else X = Tmp & O & X

If L < 11 Then GoTo Ex 'Bileon(10,000,000,000)''11 numbers'''''''''''''''''''''''''''''''
Ten_Of_Bileons:

If L > 11 Then If Val(W(12)) <> 0 Or Val(W(11)) < 1 Then GoTo Houndred_Of_Bileons 'Jump

If Val(W(11)) = 1 Then Tmp = "E?C??" Else Tmp = "E????"

X = Zeros(W, X, 11)

   If Val(W(11)) = 1 Then 'Tenth Bileons:10,000,000,000
   If Val(W(10)) = 0 Then X = CN(Val(W(11))) & S & Tmp & O & X Else _
   Tmp = "E????": X = BN(Val(W(10))) & S & Tmp & O & X 'Elventh Bileons
   Else
   If Val(W(10)) = 0 Then X = CN(Val(W(11))) & S & Tmp & O & X Else _
    X = AN(Val(W(10))) & O & CN(Val(W(11))) & S & Tmp & O & X   '12,000,000,000
   End If
   
If L < 12 Then GoTo Ex 'Bileon(100,000,000,000)''12 numbers'''''''''''''''''''''''''''''''
Houndred_Of_Bileons:
If L > 12 And Val(W(12)) < 1 Then GoTo Trlion

Tmp = "E????"
X = Zeros(W, X, 12)

   If Val(W(10)) = 0 And Val(W(11)) = 0 Then    '100,000,000,000
   X = DN(Val(W(12))) & S & Tmp & O & X 'Puer Houndreds Of Bileons
   Else '110,000,000,000
   '1- Houndreds Of Bileons & Elvenths : ..2- Else :Houndreds Of Bileons & Frist numbers
   If Val(W(11)) = 1 Then X = DN(Val(W(12))) & O & BN(Val(W(10))) & S & Tmp & O & X Else _
   X = DN(Val(W(12))) & O & AN(Val(W(10))) & S & CN(Val(W(11))) & S & Tmp & O & X
   End If
   
X = Replace(X, "?C?E?? E????", "??E? E????")

If L < 13 Then GoTo Ex 'Trlion(1,000,000,000,000)''13 numbers'''''''''''''''''''''''''''''''
Trlion:

If Val(W.Item(13)) < 1 Then GoTo Ten_Of_Trlions 'Jump
If L > 13 Then If Val(W.Item(14)) <> 0 Then GoTo Ten_Of_Trlions 'Jump
If L > 14 Then If Val(W.Item(15)) <> 0 Then GoTo Ten_Of_Trlions 'Jump


Tmp = "E?????CE"

   If Val(W.Item(13)) = 1 Then
   Tmp = "E?????"
   ElseIf Val(W.Item(13)) = 2 Then
   Tmp = "E???????"
   End If
   
   
X = Zeros(W, X, 13)
If Val(W.Item(13)) > 2 Then X = AN(Val(W(13))) & S & Tmp & O & X Else X = Tmp & O & X

If L < 14 Then GoTo Ex 'Ten_Of_Trlions(10,000,000,000,000)''14 numbers'''''''''''''''''''''''''''''''
Ten_Of_Trlions:

If L > 14 Then If Val(W(15)) <> 0 Or Val(W(14)) < 1 Then GoTo Houndreds_Of_Trlions 'Jump

If Val(W(14)) = 1 Then Tmp = "E?????CE" Else Tmp = "E?????"

X = Zeros(W, X, 14)

   If Val(W(14)) = 1 Then 'Tenth Trlions:10,000,000,000,000
   If Val(W(13)) = 0 Then X = CN(Val(W(14))) & S & Tmp & O & X Else _
   Tmp = "E?????": X = BN(Val(W(13))) & S & Tmp & O & X 'Elventh Trlions
   Else
   If Val(W(13)) = 0 Then X = CN(Val(W(14))) & S & Tmp & O & X Else _
    X = AN(Val(W(13))) & O & CN(Val(W(14))) & S & Tmp & O & X   '12,000,000,000,000
   End If
   
If L < 15 Then GoTo Ex 'Houndreds_Of_Trlions(100,000,000,000,000)''15 numbers'''''''''''''''''''''''''''''''
Houndreds_Of_Trlions:
If L > 15 And Val(W(15)) < 1 Then GoTo Quadrillion

Tmp = "E?????"
X = Zeros(W, X, 15)

   If Val(W(13)) = 0 And Val(W(14)) = 0 Then    '100,000,000,000,000
   X = DN(Val(W(15))) & S & Tmp & O & X 'Puer Houndreds Of Trlions
   Else '110,000,000,000,000
   '1- Houndreds Of Trlions & Elvenths : ..2- Else :Houndreds Of Trlions & Frist numbers
   If Val(W(14)) = 1 Then X = DN(Val(W(15))) & O & BN(Val(W(13))) & S & Tmp & O & X Else _
   X = DN(Val(W(15))) & O & AN(Val(W(13))) & S & CN(Val(W(14))) & S & Tmp & O & X
   End If
   
X = Replace(X, "?C?E?? E?????", "??E? E?????")

If L < 16 Then GoTo Ex 'Quadrillion(1,000,000,000,000,000)''16 numbers'''''''''''''''''''''''''''''''
Quadrillion:

If Val(W.Item(16)) < 1 Then GoTo Ten_Of_Quadrillions 'Jump
If L > 16 Then If Val(W.Item(17)) <> 0 Then GoTo Ten_Of_Quadrillions 'Jump
If L > 17 Then If Val(W.Item(18)) <> 0 Then GoTo Ten_Of_Quadrillions 'Jump


Tmp = "??CI?????CE"

   If Val(W.Item(16)) = 1 Then
   Tmp = "??CI?????"
   ElseIf Val(W.Item(16)) = 2 Then
   Tmp = "??CI???????"
   End If
   
   
X = Zeros(W, X, 16)
If Val(W.Item(16)) > 2 Then X = AN(Val(W(16))) & S & Tmp & O & X Else X = Tmp & O & X

If L < 17 Then GoTo Ex 'Ten_Of_Quadrillions(10,000,000,000,000,000)''17 numbers'''''''''''''''''''''''''''''''
Ten_Of_Quadrillions:

If L > 17 Then If Val(W(18)) <> 0 Or Val(W(17)) < 1 Then GoTo Houndreds_Of_Quadrillions 'Jump

If Val(W(17)) = 1 Then Tmp = "??CI?????CE" Else Tmp = "??CI?????"

X = Zeros(W, X, 17)

   If Val(W(17)) = 1 Then 'Tenth Quadrillions
   If Val(W(16)) = 0 Then X = CN(Val(W(17))) & S & Tmp & O & X Else _
   Tmp = "??CI?????": X = BN(Val(W(16))) & S & Tmp & O & X 'Elventh Quadrillions
   Else
   If Val(W(16)) = 0 Then X = CN(Val(W(17))) & S & Tmp & O & X Else _
    X = AN(Val(W(16))) & O & CN(Val(W(17))) & S & Tmp & O & X   '12,000,000,000,000,000
   End If
   
If L < 18 Then GoTo Ex 'Houndreds_Of_Quadrillions(100,000,000,000,000,000)''18 numbers'''''''''''''''''''''''''''''''
Houndreds_Of_Quadrillions:

If L > 18 And Val(W(18)) < 1 Then GoTo Zlion

Tmp = "??CI?????"
X = Zeros(W, X, 18)

   If Val(W(16)) = 0 And Val(W(17)) = 0 Then    '100,000,000,000
   X = DN(Val(W(18))) & S & Tmp & O & X 'Puer Houndreds Of Quadrillions
   Else '110,000,000,000
   '1- Houndreds Of Quadrillions & Elvenths : ..2- Else :Houndreds Of Quadrillions & Frist numbers
   If Val(W(17)) = 1 Then X = DN(Val(W(18))) & O & BN(Val(W(16))) & S & Tmp & O & X Else _
   X = DN(Val(W(18))) & O & AN(Val(W(16))) & S & CN(Val(W(17))) & S & Tmp & O & X
   End If
   
X = Replace(X, "?C?E?? ??CI?????", "??E? ??CI?????")

If L < 19 Then GoTo Ex 'Houndreds_Of_Quadrillions(100,000,000,000,000,000)''18 numbers'''''''''''''''''''''''''''''''
Zlion: '[The end]'''Last Naming number
X = "": X = "?????" & vbCrLf & "C?????? : ??? U?? ??I?I ???? C?E???CE C??????E"

End If ''___ CLOSE IF ______________________________________________(L > 4)
'''''''''''''''''''''''''''''''''Check End: ''''''''''''''''''''''''''''''''''''''''''''''

Ex:
Set W = Nothing
X = Replace(X, O & O, O) ''Delte extra waws
'delete last waw
If Len(X) > 2 Then _
If Mid(X, Len(X) - 2, 2) = " ?" Or Mid(X, Len(X) - 2, 2) = "? " Then X = Left(X, Len(X) - 2)
ToWordsArb = X
End Function
 Function Zeros(Col As Collection, X As String, MAX As Integer) As String
Dim T As Integer, I As Boolean
If MAX < 1 Then Exit Function
   For T = 1 To Col.Count
   If Val(Col.Item(T)) <> 0 Then I = True: Exit For
   If T = MAX Then Exit For
   Next T
If I Then Zeros = X Else Zeros = ""
End Function


-----------<( نهاية الكود)>-----------