Microsoft Visual Basic
Résolu
DJAMALOS
Messages postés
356
Date d'inscription
Statut
Membre
Dernière intervention
-
mic13710 Messages postés 1165 Date d'inscription Statut Membre Dernière intervention -
mic13710 Messages postés 1165 Date d'inscription Statut Membre Dernière intervention -
Bonjour,
Microsoft Visual Basic
Comment créer ou ajouter une fonction dans Visual Basic Retour à la ligne dans excel 2007
Exemple :Quatre Mille Dinars (Retour à la ligne)
Et 03 Centimes
Mille Merci
Microsoft Visual Basic
Comment créer ou ajouter une fonction dans Visual Basic Retour à la ligne dans excel 2007
Exemple :Quatre Mille Dinars (Retour à la ligne)
Et 03 Centimes
Mille Merci
11 réponses
-
Salut,
"Quatre Mille Dinars" & Chr(10) & "03 Centimes"
Michel -
Salut le forum
Avec un vbCrLf (carriage return + line feed)
Range("A1") = "Texte 1" & vbCrLf & "Texte 2"
Mytå -
Merci Michel
voici un exemple pour mieu vous expliquer
Select Case Devise
Case 0
If byDec > 0 Then strDev = " et "
Case 1
strDev = " Euro"
If dblEnt >= 1000000 And Right(dblEnt, 6) = "000000" Then strDev = " d'Euro"
If byDec > 0 Then strCentimes = strCentimes & " Cent"
If byDec > 1 Then strCentimes = strCentimes & "s"
Case 2
strDev = " Dinar"
If byDec > 0 Then strCentimes = strCentimes & " Cts"
Case 3
strDev = " €uro"
If dblEnt >= 1000000 And Right(dblEnt, 6) = "000000" Then strDev = " d'€uro"
If byDec > 0 Then strCentimes = strCentimes & " Cent"
If byDec > 1 Then strCentimes = strCentimes & "s"
End Select
a partir du dinar que je vous une Interligne (ou retour à la ligne) Merci -
Mytå
Merci l'ami j'attends votre aide -
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question -
Myta et Michel
ca na rien donner autres proposition Merci -
j'ai essayer
If byDec > 0 Then strCentimes = vbCrLf & strCentimes & " Cts"
ca na rien donné merci comme meme -
Michel Bonjour
Pardon pour retard absolument rien de changé
ou dois-je mettre la ligne que vous m'avez conseillé et Merci -
aucun, meme resultat exemple :
toujours : mille dinars et soixante centimes
au lieu
de mille dinars
et soixante centimes
merci-
Votre résultat ne colle pas avec votre code.
Vous écrivez "Dinars" avec un s alors que votre code recherche "Dinar".
Etes-vous sûr que votre strDev = "Dinar" est correct ?
Si c'était le cas, votre résultat devrait être soixante Cts et non centimes.
Pouvez-vous mettre la ou les lignes qui suivent votre code ou du moins celles qui servent à compiler le résultat ?
Michel
-
-
Michel
voici le code complet
Option Explicit
'***********
' Devise=0 aucune
' =1 Euro €
' =2 Dinar DA
' =3 €uro €
' Langue=0 Français
' =1 Belgique
' =2 Suisse
' Casse =0 Minuscule
' =1 Majuscule en début de phrase
' =2 Majuscule
' =3 Majuscule en début de chaque mot
' ZeroCent=0 Ne mentionne pas les cents s'ils sont égal à 0
' =1 Mentionne toujours les cents
'***********
' Conversion limitée à 999 999 999 999 999 ou 9 999 999 999 999,99
' si le nombre contient plus de 2 décimales, il est arrondit à 2 décimales
Public Function ConvNumberLetter(Nombre As Double, Optional Devise As Byte = 2, _
Optional Langue As Byte = 0, _
Optional Casse As Byte = 3, _
Optional ZeroCent As Byte = 0) As String
Dim dblEnt As Variant, byDec As Byte
Dim bNegatif As Boolean
Dim strDev As String, strCentimes As String
If Nombre < 0 Then
bNegatif = True
Nombre = Abs(Nombre)
End If
dblEnt = Int(Nombre)
byDec = CInt((Nombre - dblEnt) * 100)
If byDec = 0 Then
If dblEnt > 999999999999999# Then
ConvNumberLetter = "#TropGrand"
Exit Function
End If
Else
If dblEnt > 9999999999999.99 Then
ConvNumberLetter = "#TropGrand"
Exit Function
End If
End If
Select Case Devise
Case 0
If byDec > 0 Then strDev = " et "
Case 1
strDev = " Euro"
If dblEnt >= 1000000 And Right(dblEnt, 6) = "000000" Then strDev = " d'Euro"
If byDec > 0 Then strCentimes = strCentimes & " Cent"
If byDec > 1 Then strCentimes = strCentimes & "s"
Case 2
strDev = " Dinar"
If byDec > 0 Then strCentimes = strCentimes & " Cts"
Case 3
strDev = " €uro"
If dblEnt >= 1000000 And Right(dblEnt, 6) = "000000" Then strDev = " d'€uro"
If byDec > 0 Then strCentimes = strCentimes & " Cent"
If byDec > 1 Then strCentimes = strCentimes & "s"
End Select
If dblEnt > 1 And Devise <> 0 Then strDev = strDev & "s"
strDev = strDev & " "
If dblEnt = 0 Then
ConvNumberLetter = "zéro " & strDev
Else
ConvNumberLetter = ConvNumEnt(CDbl(dblEnt), Langue) & strDev
End If
If byDec = 0 Then
If Devise <> 0 Then
If ZeroCent = 1 Then ConvNumberLetter = ConvNumberLetter & "zéro Cent"
End If
Else
If Devise = 0 Then
ConvNumberLetter = ConvNumberLetter & _
ConvNumDizaine(byDec, Langue, True) & strCentimes
Else
ConvNumberLetter = ConvNumberLetter & _
ConvNumDizaine(byDec, Langue, False) & strCentimes
End If
End If
ConvNumberLetter = Replace(ConvNumberLetter, " ", " ")
If Left(ConvNumberLetter, 1) = " " Then ConvNumberLetter = _
Right(ConvNumberLetter, Len(ConvNumberLetter) - 1)
If Right(ConvNumberLetter, 1) = " " Then ConvNumberLetter = _
Left(ConvNumberLetter, Len(ConvNumberLetter) - 1)
Select Case Casse
Case 0
ConvNumberLetter = LCase(ConvNumberLetter)
Case 1
ConvNumberLetter = UCase(Left(ConvNumberLetter, 1)) & _
LCase(Right(ConvNumberLetter, Len(ConvNumberLetter) - 1))
Case 2
ConvNumberLetter = UCase(ConvNumberLetter)
Case 3
ConvNumberLetter = Application.WorksheetFunction.Proper(ConvNumberLetter)
If Devise = 3 Then _
ConvNumberLetter = Replace(ConvNumberLetter, "€Uros", "€uros", , , vbTextCompare)
End Select
End Function
Private Function ConvNumEnt(Nombre As Double, Langue As Byte)
Dim iTmp As Variant, dblReste As Double
Dim strTmp As String
Dim iCent As Integer, iMille As Integer, iMillion As Integer
Dim iMilliard As Integer, iBillion As Integer
iTmp = Nombre - (Int(Nombre / 1000) * 1000)
iCent = CInt(iTmp)
ConvNumEnt = Nz(ConvNumCent(iCent, Langue))
dblReste = Int(Nombre / 1000)
If iTmp = 0 And dblReste = 0 Then Exit Function
iTmp = dblReste - (Int(dblReste / 1000) * 1000)
If iTmp = 0 And dblReste = 0 Then Exit Function
iMille = CInt(iTmp)
strTmp = ConvNumCent(iMille, Langue)
Select Case iTmp
Case 0
Case 1
strTmp = " mille "
Case Else
strTmp = strTmp & " mille "
End Select
If iMille = 0 And iCent > 0 Then ConvNumEnt = "et " & ConvNumEnt
ConvNumEnt = Nz(strTmp) & ConvNumEnt
dblReste = Int(dblReste / 1000)
iTmp = dblReste - (Int(dblReste / 1000) * 1000)
If iTmp = 0 And dblReste = 0 Then Exit Function
iMillion = CInt(iTmp)
strTmp = ConvNumCent(iMillion, Langue)
Select Case iTmp
Case 0
Case 1
strTmp = strTmp & " million "
Case Else
strTmp = strTmp & " millions "
End Select
If iMille = 1 Then ConvNumEnt = "et " & ConvNumEnt
ConvNumEnt = Nz(strTmp) & ConvNumEnt
dblReste = Int(dblReste / 1000)
iTmp = dblReste - (Int(dblReste / 1000) * 1000)
If iTmp = 0 And dblReste = 0 Then Exit Function
iMilliard = CInt(iTmp)
strTmp = ConvNumCent(iMilliard, Langue)
Select Case iTmp
Case 0
Case 1
strTmp = strTmp & " milliard "
Case Else
strTmp = strTmp & " milliards "
End Select
If iMillion = 1 Then ConvNumEnt = "et " & ConvNumEnt
ConvNumEnt = Nz(strTmp) & ConvNumEnt
dblReste = Int(dblReste / 1000)
iTmp = dblReste - (Int(dblReste / 1000) * 1000)
If iTmp = 0 And dblReste = 0 Then Exit Function
iBillion = CInt(iTmp)
strTmp = ConvNumCent(iBillion, Langue)
Select Case iTmp
Case 0
Case 1
strTmp = strTmp & " billion "
Case Else
strTmp = strTmp & " billions "
End Select
If iMilliard = 1 Then ConvNumEnt = "et " & ConvNumEnt
ConvNumEnt = Nz(strTmp) & ConvNumEnt
End Function
Private Function ConvNumDizaine(Nombre As Byte, Langue As Byte, bDec As Boolean) As String
Dim TabUnit As Variant, TabDiz As Variant
Dim byUnit As Byte, byDiz As Byte
Dim strLiaison As String
If bDec Then
TabDiz = Array("zéro", "", "vingt", "trente", "quarante", "cinquante", _
"soixante", "soixante", "quatre vingt", "quatre vingt")
Else
TabDiz = Array("", "", "vingt", "trente", "quarante", "cinquante", _
"soixante", "soixante", "quatre vingt", "quatre vingt")
End If
If Nombre = 0 Then
TabUnit = Array("zéro")
Else
TabUnit = Array("", "un", "deux", "trois", "quatre", "cinq", "six", "sept", _
"huit", "neuf", "dix", "onze", "douze", "treize", "quatorze", "quinze", _
"seize", "dix sept", "dix huit", "dix neuf")
End If
If Langue = 1 Then
TabDiz(7) = "septante"
TabDiz(9) = "nonante"
ElseIf Langue = 2 Then
TabDiz(7) = "septante"
TabDiz(8) = "huitante"
TabDiz(9) = "nonante"
End If
byDiz = Int(Nombre / 10)
byUnit = Nombre - (byDiz * 10)
strLiaison = " "
If byUnit = 1 Then strLiaison = " et "
Select Case byDiz
Case 0
strLiaison = " "
Case 1
byUnit = byUnit + 10
strLiaison = " "
Case 7
If Langue = 0 Then byUnit = byUnit + 10
Case 8
If Langue <> 2 Then strLiaison = " "
Case 9
If Langue = 0 Then
byUnit = byUnit + 10
strLiaison = " "
End If
End Select
ConvNumDizaine = TabDiz(byDiz)
If byDiz = 8 And Langue <> 2 And byUnit = 0 Then ConvNumDizaine = ConvNumDizaine & "s"
If TabUnit(byUnit) <> "" Then
ConvNumDizaine = ConvNumDizaine & strLiaison & TabUnit(byUnit)
Else
ConvNumDizaine = ConvNumDizaine
End If
End Function
Private Function ConvNumCent(Nombre As Integer, Langue As Byte) As String
Dim TabUnit As Variant
Dim byCent As Byte, byReste As Byte
Dim strReste As String
TabUnit = Array("", "un", "deux", "trois", "quatre", "cinq", "six", "sept", _
"huit", "neuf", "dix")
byCent = Int(Nombre / 100)
byReste = Nombre - (byCent * 100)
strReste = ConvNumDizaine(byReste, Langue, False)
Select Case byCent
Case 0
ConvNumCent = strReste
Case 1
If byReste = 0 Then
ConvNumCent = "cent"
Else
ConvNumCent = "cent " & strReste
End If
Case Else
If byReste = 0 Then
ConvNumCent = TabUnit(byCent) & " cents"
Else
ConvNumCent = TabUnit(byCent) & " cent " & strReste
End If
End Select
End Function
Private Function Nz(strNb As String) As String
If strNb <> " zéro" Then Nz = strNb
End Function
Résultat trouvé :
Cent Deux Mille Trois Cent Soixante Quinze Dinars Trente Neuf Cts
tout est ok mais le vrai probleme c'est que je veux les Cts soient au dessous des dinars exemple :
Cent Deux Mille Trois Cent Soixante Quinze Dinars (à ligne)
Trente Neuf Cts (ou 39 Cts)
Mille Merci-
Je comprends mieux pourquoi ça ne marche pas : ce n'est pas un affichage direct d'une chaine comme on pouvait l'imaginer dans votre question, mais c'est une fonction autrement plus complexe que les simples lignes que vous nous avez présenté au départ.
Et il y a du monde !
Compte tenu de la complexité de votre code, il faut du temps pour comprendre tout le fonctionnement avant de pouvoir y apporter une solution.
Il y a là en tout cas de quoi intéresser les amateurs de beaux codes !
Michel -
Après analyse de votre code ci-après en gras les lignes à ajouter dans la fonction publique :
If Devise = 0 Then ConvNumberLetter = ConvNumberLetter & _ ConvNumDizaine(byDec, Langue, True) & strCentimes ElseIf Devise = 2 Then ConvNumberLetter = ConvNumberLetter & _ Chr(10) & ConvNumDizaine(byDec, Langue, False) & strCentimes Else ConvNumberLetter = ConvNumberLetter & _ ConvNumDizaine(byDec, Langue, False) & strCentimes End If
Et pour que l'affichage se fasse sur 2 lignes, il faut autoriser le renvoi à la ligne dans la cellule, sinon, c'est un carré qui s'affiche.
Je vous signale aussi un problème sur le numéro de référence des devises. Il est possible de mettre un code > 3, auquel cas l'affichage inclus un s inutile et devient incompréhensible.
Pour corriger, je propose de mettre la devise à 0 si la valeur saisie est supérieure à 3. Pour se faire, rajouter la ligne en gras avant le select case comme suit :
......... Exit Function End If End If If Devise > 3 Then Devise = 0 Select Case Devise Case 0 If byDec > 0 Then strDev = " et " Case 1 ...........
Cordialement,
Michel
-
-
Mytå
Bonjour j'attends votre aide Merci -
Bonjour Michel
voila ca n'a tjrs pa fonctionné, voici un exemple et mille merci pour avoir donné un peux de votre temps et votre aide.
http://www.cijoint.fr/cjlink.php?file=cj201101/cijyuwRI2o.xls-
Bonsoir,
Ca ne marche pas parce que vous n'avez pas autorisé le renvoi à la ligne de la cellule comme je vous l'avais indiqué.
Reprenez mon message. J'ai écrit :
"Et pour que l'affichage se fasse sur 2 lignes, il faut autoriser le renvoi à la ligne dans la cellule, sinon, c'est un carré qui s'affiche. "
Or vous avez un carré dans votre exemple.
Pour afficher sur 2 lignes : Format/Cellule/Alignement, cliquer sur "Renvoyer à la ligne automatiquement"
C'est obligatoire si vous voulez le résultat sur 2 lignes.
Et pour pérenniser ce format sur votre document, je vous conseille aussi de régler sur ce même onglet le positionnement vertical sur "Centré".
Enfin, il faut aussi régler la hauteur de la ligne à 32 pour être sûr que l'affichage pourra se faire sur 2 lignes. (Format/Ligne/Hauteur)
J'ai cherché une méthode pour que ce réglage se fasse automatiquement suivant la devise sélectionnée, sans succès. Il semble impossible de modifier la hauteur de ligne sur le résultat d'une fonction publique. Mais je me trompe peut-être.
En attendant, si vous faites les réglages que je vous ai indiqué, votre montant en Dinar apparaîtra sur 2 lignes comme vous le souhaitez. Les autres montants seront affichés dans le même cadre au centre sur une ligne.
Quant à mettre les centimes en chiffres (votre remarque sur votre exemple), il faudrait encore rechercher les lignes à modifier ce qui n'est pas simple, et c'est à mon avis un travail peu utile qui risquerait de perturber le bon fonctionnement de la macro.
Petite modification à effectuer sur votre macro :
Supprimer celle-ci en gras demandé dans mon dernier post :......... Exit Function End If End If If Devise > 3 Then Devise = 0 Select Case Devise Case 0 If byDec > 0 Then strDev = " et " Case 1 ...........
Et insérer ces lignes en gras :
Public Function ConvNumberLetter(Nombre As Double, Optional Devise As Byte = 2, _ Optional Langue As Byte = 0, _ Optional Casse As Byte = 3, _ Optional ZeroCent As Byte = 0) As String Dim dblEnt As Variant, byDec As Byte Dim bNegatif As Boolean Dim strDev As String, strCentimes As String If Nombre < 0 Then bNegatif = True Nombre = Abs(Nombre) End If If Devise > 3 Then Devise = 2 If Langue > 2 Then Langue = 0 If Casse > 3 Then Casse = 3 dblEnt = Int(Nombre) byDec = CInt((Nombre - dblEnt) * 100)
C'est pour éviter de rentrer des valeurs hors plage de saisie. Les valeurs sont alors mises par défaut.
Michel -
-
