Bonjour.
le fichier xla se présente ainsi :
Option Explicit
Option Base 1
Public Unité As Variant
Public dizaine As Variant
Public Décimales As Currency
Public CasPart As Variant
Public lettres As String
Public Numlettre As String
Public Cent_Pluriel As Boolean
Public Vingt_Pluriel As Boolean
'
' -------------------
' FONCTION PRINCIPALE ARABIC version
' -------------------
'
Function ConvArabe(Nombre As Currency) As String
' Limitation à 999 999 999 999 . 99
If Nombre >= 1000000000000# Then
MsgBox "Ce nombre est trop grand !", 0, "Message"
Exit Function
End If
' Initialisation des tableaux
Unité = Array("ÊÓÚÉ", "ËãÇäíÉ", "ÓÈÚÉ", "ÓÊÉ", "ÎãÓÉ", "ÇÑÈÚÉ", "ËáÇËÉ", "ÇËäíä", "æÇÍÏ")
dizaine = Array("ÊÓÚæä", "ËãÇäæä", "ÓÈÚæä", "ÓÊæä", "ÎãÓæä", "ÇÑÈÚæä", "ËáÇËæä", "ÚÔÑæä", "ÚÔÑÉ")
CasPart = Array("ÊÓÚÉ ÚÔÑÉ", "ËãÇäíÉ ÚÔÑÉ", "ÓÈÚÉ ÚÔÑÉ", "ÓÊÉ ÚÔÑÉ", "ÎãÓÉ ÚÔÑÉ", "ÇÑÈÚÉ ÚÔÑÉ", "ËáÇËÉ ÚÔÑÉ", "ÇËä ÚÔÑÉ", "ÇÍÏ ÚÔÑÉ", "ÚÔÑÉ")
' Mise à vide de la chaîne de réception de la traduction du nombre
lettres = ""
' Initialisation des indicateurs de pluriel des nombres cent et vingt
Cent_Pluriel = True
Vingt_Pluriel = True
' Conversion de la partie décimale en un nombre de 0 à 99
' arrondi à l'unité la plus proche
Décimales = CInt((Nombre - Fix(Nombre)) * 100)
' Conservation de la partie entière du nombre
Nombre = Fix(Nombre)
' Orientation du traitement suivant valeur de la partie entière
Select Case Nombre
Case 0
lettres = "ÕÝÑ"
Case 1 To 9
lettres = Unité(CInt(Nombre))
Case 10 To 99
Trt_Dizaines Nombre
Case 100 To 999
Trt_Centaines Nombre
Case 1000 To 999999999999#
Trt_Multiples_de_Mille Nombre
End Select
' Indication de la monnaie
If Nombre > 1 Then
' if then
lettres = lettres & " ãÜáÜíÜã"
'Else
'End If
Else
lettres = lettres & " ãÜáÜíÜã"
End If
' Orientation du traitement suivant valeur de la partie décimale
Select Case Décimales
Case 1 To 9
lettres = lettres & Unité(CInt(Décimales))
Case 10 To 99
Trt_Dizaines Décimales
End Select
' Indication des centimes
Select Case Décimales
Case 1
lettres = lettres & " ãÜÇÆÜÉ"
Case Is > 1
lettres = lettres & " ãÜÇÆÜÉ"
End Select
' Renvoi du nombre traduit en lettres
ConvArabe = lettres
End Function
'
' --------------------------------
' TRAITEMENT DES MULTIPLES DE 1000
' --------------------------------
'
Sub Trt_Multiples_de_Mille(Nombre As Currency)
Dim Rank As Currency
Dim Nom_Rang As String
Dim Reste As Currency
Cent_Pluriel = False
Vingt_Pluriel = False
' Initialisation suivant taille du nombre : milliers, millions ou milliards
Select Case Nombre
Case 1000 To 999999
Rank = Fix(Nombre / 1000)
Reste = Nombre Mod 1000
Nom_Rang = "ÂáÇÝ"
Case 1000000 To 999999999
Rank = Fix(Nombre / 1000000)
Reste = Nombre Mod 1000000
If Rank > 1 Then
Nom_Rang = "ãÜáÇíÜíÜä"
Else
Nom_Rang = "ãÜáÇíÜíÜä"
End If
Case Is > 999999999
Rank = Fix(Nombre / 1000000000)
Reste = Nombre - Rank * 1000000000
If Rank > 1 Then
Nom_Rang = "ÇáÜÝ ãÜáÜíÜæä"
Else
Nom_Rang = "ÂáÇÝ ÇáÜãÜáÜíÜæä"
End If
End Select
' Traitement du rang des milliers, millions ou milliards
Select Case Rank
Case 1
If Nom_Rang = "ÇáÜÝ" Then
lettres = lettres & "ÂáÇÝ"
Else
lettres = lettres & Unité(CInt(Rank)) & " " & Nom_Rang '& " æ"
End If
Case 2 To 9
'MsgBox ("Lettres = " & Lettres)
'MsgBox ("Unité(CInt(Rank)) = " & Unité(CInt(Rank)))
'MsgBox ("Nom_Rang = " & Nom_Rang)
lettres = lettres & Unité(CInt(Rank)) & " " & Nom_Rang '& " æ"
Case 10 To 99
Trt_Dizaines (Rank)
lettres = lettres & " " & Nom_Rang '& " æ"
Case 100 To 999
Trt_Centaines Rank
lettres = lettres & " " & Nom_Rang '& " æ"
End Select
Cent_Pluriel = True
Vingt_Pluriel = True
' Orientation du traitement du reste si > 0
Select Case Reste
Case 1 To 9
lettres = lettres & " æ" & " " & Unité(CInt(Reste))
Case 10 To 99
lettres = lettres & " æ" & " "
Trt_Dizaines Reste
Case 100 To 999
lettres = lettres & " æ" & " "
Trt_Centaines Reste
Case Is > 999
lettres = lettres & " æ" & " "
Trt_Multiples_de_Mille Reste
Case Else
lettres = lettres & " "
End Select
lettres = lettres
End Sub
'
' -----------------------------------
' TRAITEMENT DES NOMBRES DE 100 0 999
' -----------------------------------
'
Sub Trt_Centaines(Nombre As Currency)
Dim Rank As Currency
Dim Reste As Currency
Rank = Fix(Nombre / 100)
Reste = Nombre Mod 100
' Traitement du rang des centaines
If Rank = 1 Then
If Reste = 0 Then
lettres = lettres & "ãÜÇÆÜÉ"
Else
lettres = lettres & "ãÜÇÆÜÉ" & " æ"
End If
Else
If Reste = 0 And Cent_Pluriel Then
lettres = lettres & Unité(CInt(Rank)) & " " & "ãÜÇÆÜÉ"
Else
lettres = lettres & Unité(CInt(Rank)) & " " & "ãÜÇÆÜÉ" & " æ"
End If
End If
' Traitement du reste < 100
Select Case Reste
Case 1 To 9
lettres = lettres & " " & Unité(CInt(Reste))
Case Is > 9
lettres = lettres & " "
Vingt_Pluriel = True
Trt_Dizaines (Reste)
End Select
End Sub
'
' ---------------------------------
' TRAITEMENT DES NOMBRES DE 10 0 99
' ---------------------------------
'
Sub Trt_Dizaines(Nombre As Currency)
Dim Reste As Integer
Dim Rank As Integer
Rank = Fix(Nombre / 10)
Reste = Nombre Mod 10
Select Case Rank
Case 1
lettres = lettres & CasPart(Reste + 1)
Case 7
Select Case Reste
Case 0
' Nombre 70
lettres = lettres & dizaine(Rank)
Case Else
' Nombre 71 à 76
lettres = lettres & Unité(CInt(Reste)) & " æ " & dizaine(Rank)
End Select
Case 8
If Reste = 0 Then
' Nombre 80
lettres = lettres & dizaine(Rank)
Else
' Nombres 81 à 89
lettres = lettres & Unité(CInt(Reste)) & " æ " & dizaine(Rank)
End If
Case 9
If Reste = 0 Then
' Nombres 90
lettres = lettres & dizaine(Rank)
Else
' Nombres 91 à 99
lettres = lettres & Unité(CInt(Reste)) & " æ " & dizaine(Rank)
End If
Case Else
' Nombres 20 à 69
Select Case Reste
Case 0
' Nombres 20, 30, 40, 50, 60
lettres = lettres & dizaine(Rank)
Case Else
' Autres nombres
lettres = lettres & Unité(CInt(Reste)) & " æ " & dizaine(Rank)
End Select
End Select
End Sub
Merci à la personne qui a fait le fichier nblettre auquel il a été modifié pour faire les lettres en arabe mais que je n'ai pu utiliser