XL 2013 vba fonction

CHEDELIX

XLDnaute Nouveau
Bonjour. dans une fonction pour écrire un chiffre en lettres arabes le résultat qui s'affiche est "ËáÇËÉ æ ÚÔÑÉ ãÜáÜíÜãÇËäíä æ ÚÔÑÉ ãÜÇÆÜÉ". Pourtant dans le module vba, les caractères en arabe s'affichent correctement....! dans le fichier excel la police est time new roman. comment faire ?
 

Dranreb

XLDnaute Barbatruc
Bonjour.
Je n'ai absolument rien compris à votre description du problème.
Ça m'étonnerait qu'on puisse voir des caractères arabes dans la fenêtre de code VBE !
Joignez un fichier, qu'on ait une chance de voir de quoi il retourne.
Je soupçonne vaguement une utilisation de Chr$ là où il faudrait ChrW$ parce que ce seraient des valeurs UniCode dépassant les valeurs ASCII du jeu de caractères codés sur un seul octet…
 

CHEDELIX

XLDnaute Nouveau
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
 

Dranreb

XLDnaute Barbatruc
Bonjour.
Et où voyez vous des caractères arabes dans le code inexploitable que vous reproduisez sans même avoir pris la peine d'utiliser le bouton Code </> ?
Avez vous au moins les caractères arabes quelque part, dans des cellules de feuilles par exemple ?
C'est le classeur que je vous ai demandé de joindre, pas ça !
 

Dranreb

XLDnaute Barbatruc
Votre classeur utilise 3 compléments .xla que je ne possède pas.
Je ne peux donc pas étudier ce que renvoient leurs fonctions.
J'ai partout #NOM?.
Celà dit il est possible que ce soit prévu pour fonctionner avec une police de caractères spéciale, mais je ne sais pas laquelle.
 
Dernière édition:

CHEDELIX

XLDnaute Nouveau
Bonjour,
voici le fichier xlsx. Une fois ouvert, quand vous allez au "Développeur" et que vous sélectionnez l'onglet "Visual Basic" la fenêtre de projet vba affiche différends projets, dont le projet du nom "ConArabe.xla où il y a des caractères en arabe. C'est ce projet que donne le résultat des caractères indéchiffrables.
 

Dranreb

XLDnaute Barbatruc
Oui mais je ne possède pas ces fichier et n'ai donc pas en ligne leurs projets VBA.
Il faudrait que vous étudiez ce que renvoient exactement leurs fonctions. Si ce sont des chaines de caractères occidentaux c'est qu'ils sont destinés à être reproduit par une police spéciale. Remarque: on devrait pouvoir les adapter pour qu'il utilisent des caractères Unicode.
 
Dernière édition:

CHEDELIX

XLDnaute Nouveau
Merci beaucoup.
Effectivement c'est ce que je crois avoir compris. Mais je n'arrive pas a connaitre le nom de la police en question. J'ai beau cherché et installé des polices arabes, mais en vain...!
 

Dranreb

XLDnaute Barbatruc
Tout ce que je peux vous suggérer c'est d'étudier ce lien. Essayez la fonction Excel UNICAR ou, si vous ne l'avez pas dans votre version d'Excel, la fonction VBA ChrW$
 

CHEDELIX

XLDnaute Nouveau
Bonjour Dranreb.

J'ai résolu le problème.

Il faut faire :

1-Panneau de Configuration
2-Langue
3-Modifier les Formats de Date, d'Heure & de Nombre
4-Modifier les Paramètres Régionaux
5-Options Régionales
6-Et là sélectionner "Arabe".

Merci.
 

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas