Microsoft Visual Basic

Résolu
DJAMALOS -  
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

11 réponses

  • Votes
  • Date
  • Date décroissante
  1.  DJAMALOS Auteur
    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
    1. mic13710
      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
    2. mic13710
      Y'a pas de quoi !
      (une réponse serait la bienvenue et si c'est ok merci de passer le sujet comme résolu)
  3. DJAMALOS Auteur
    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
    1. mic13710
      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
    2. mic13710
      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
  4. djamalos
    aucun, meme resultat exemple :
    toujours : mille dinars et soixante centimes
    au lieu
    de mille dinars
    et soixante centimes
    merci
    1. mic13710
      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
  6. djamalos
    Michel Bonjour
    Pardon pour retard absolument rien de changé
    ou dois-je mettre la ligne que vous m'avez conseillé et Merci
    1. DJAMALOS Auteur
      j'ai essayer
      If byDec > 0 Then strCentimes = vbCrLf & strCentimes & " Cts"
      ca na rien donné merci comme meme
      1. mic13710
        C'est à dire ?
        Quel résultat obtenez-vous ?
    4. DJAMALOS Auteur
      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
      1. mic13710
        Essayez ça :

        If byDec > 0 Then strCentimes = Chr(10) & strCentimes & " Cts"

        Ou vbCrLf à la place de Chr(10) comme l'a proposé Myta

        Michel
    5. Mytå Contributeur
      Salut le forum

      Avec un vbCrLf (carriage return + line feed)

      Range("A1") = "Texte 1" & vbCrLf & "Texte 2"

      Mytå

      Discussions similaires

      Site de confiance ou non ?
      mlle_so

      25 réponses