VB6/VBA Transformar números em letras (francês)

Dezembro 2016




Introdução


A função pode transformar números de unidade até 999.

Suporta a sintaxe para o francês de França, de Bélgica e de Suiça.




Preliminares VB6

  • 1 forma
  • 1 label : name = label1
  • OptionButton1 : name = OptionButton1 : Index = 0 : caption = "France"
  • OptionButton1 : name = OptionButton1 : Index = 1 : caption = "Belgique"
  • OptionButton1 : name = OptionButton1 : Index = 2 : caption = "Suisse"
  • 1 texteBox : name = TextBox1 : Text = ""
  • 1 CommandButton : Name = Command1 : Caption = "Envoyer"
  • 1 module : name = Module1

No módulo da forma


Private Sub Command1_Click()    
    Label1.Caption = LesMilliers(Text1.Text)    
End Sub    

Private Sub Form_Load()    
    IniteVar    
    Label1.Caption = LesMilliers("162")    
End Sub    

Private Sub Option1_Click(Index As Integer)    
    pays = Index    
    IniteVar    
End Sub    

Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)    
    If KeyCode = 13 Then    
        Label1.Caption = LesMilliers(Text1.Text)    
    End If    
End Sub

No Módule1


Public pays As Integer    
Private Unite(19) As String     
Private Dixaines(2 To 9) As String     

Public Sub IniteVar()    
Unite(0) = ""    
Unite(1) = "un "    
Unite(2) = "deux "    
Unite(3) = "trois "    
Unite(4) = "quatre "    
Unite(5) = "cinq "    
Unite(6) = "six "    
Unite(7) = "sept "    
Unite(8) = "huit "    
Unite(9) = "neuf "    
Unite(10) = "dix "    
Unite(11) = "onze "    
Unite(12) = "douze "    
Unite(13) = "treize "    
Unite(14) = "quatorze "    
Unite(15) = "quinze "    
Unite(16) = "seize "    
Unite(17) = "dix-sept "    
Unite(18) = "dix-huit "    
Unite(19) = "dix-neuf "    

Dixaines(2) = "vingt "    
Dixaines(3) = "trente "    
Dixaines(4) = "quarante "    
Dixaines(5) = "cinquante "    
Dixaines(6) = "soixante "    

Select Case pays    
Case 0 'France    
    Dixaines(7) = "soixante-dix "    
    Dixaines(8) = "quatre-vingts "    
    Dixaines(9) = "quatre-vingts-dix "    
Case 1 'Belge    
    Dixaines(7) = "septante "    
    Dixaines(8) = "quatre-vingts "    
    Dixaines(9) = "nonante "    
Case 2 'suisse    
    Dixaines(7) = "septante "    
    Dixaines(8) = "huitante "    
    Dixaines(9) = "nonante "    
End Select    

End Sub    
Function LesMilliers(Nombre As String) As String    

Dim i As Integer, e As Integer, Txt As String    
Dim ValNb(6) As Double    
Dim strResultat(6) As String    
Dim strTemp As String    
Dim a As String    

    If Val(Nombre) < 1 Then LesMilliers = "Zéro": Exit Function    
reco:    
    If Len(Nombre) / 3 <> Int(Len(Nombre) / 3) Then    
        Nombre = "0" & Nombre    
        GoTo reco    
    End If    
    e = (Len(Nombre) / 3)    
    For i = 0 To e - 1    
        Txt = Mid(Nombre, (i * 3) + 1, 3)    
        ValNb(i) = Val(Txt)    
        strResultat(i) = Centaine(Txt)    
    Next i    
    i = 0    
    If e > 4 Then téra    
        strTemp = strResultat(0) & "téra "    
        i = i + 1    
    End If    
    If e > 3 Then 'milliard    
        If ValNb(i) = 1 Then a = "milliard " Else a = "milliards "    
        strTemp = strTemp & strResultat(i) & "milliard "    
        i = i + 1    
    End If    
    If e > 2 Then 'million    
        If ValNb(i) = 1 Then a = "million " Else a = "millions "    
        strTemp = strTemp & strResultat(i) & a    
        i = i + 1    

    End If    
    If e > 1 Then 'millier    
        If ValNb(i) = 1 Then    
            strTemp = strTemp & "mille "    
        Else    
            strTemp = strTemp & strResultat(i) & "mille "    
        End If    
        i = i + 1    
    End If    
    If e > 0 Then 'les unités    
        strTemp = strTemp & strResultat(i)    
    Else 'pas de donnée    
        strTemp = "Zéro"    
    End If    
    LesMilliers = strTemp    
End Function    

Private Function Centaine(Nombre As String) As String    
Dim i As Integer, e(3) As Integer, a As String    
Dim strBuff As String    
    For i = 3 To 1 Step -1    
        e(i) = Val(Mid(Nombre, i, 1))    
    Next i    
    e(0) = Val(Right(Nombre, 2))    
        
    If e(3) = 1 Then strBuff = "et un " Else strBuff = Unite(e(3))    
        
    If e(0) < 20 Then    
        strBuff = Unite(e(0))    
    ElseIf e(0) < 70 Or (e(0) > 79 And e(0) < 90) Or pays <> 0 Then    
        strBuff = Dixaines(e(2)) & strBuff    
    Else    
        If e(0) > 89 Then i = 80 Else i = 60    
        strBuff = Dixaines(e(2) - 1) & Unite(e(0) - i)    
    End If    
        
    'Centaine    
    If e(1) = 1 Then    
        strBuff = "Cent " & strBuff    
    ElseIf e(1) >= 1 Then    
        If e(0) = 0 Then a = "cents " Else a = "cent "    
        strBuff = Unite(e(1)) & a & strBuff    
    End If    
    Centaine = strBuff    
End Function

Download Office

  • Planilhas Excel de teste

classeur Nombre en lettre.xls

Macro complementar Office

  • Download a planilha aqui abaixo
  • Abrir Excel >> Ferramentas >> Macros complementares >> Percorrer
  • Busca o arquivo LN_Nbrelettre.xla >> >> Marque a referência >> OK
  • O macro "EmTexto" está disponível no assistente colar uma função > Personalizadas
  • Parâmetros da função

1 - Língua
  • 0 = France
  • 1 = Belgique
  • 2 = Suissie

2 - Devise
  • 0 = Aucune
  • 1 = Dollard
  • 2 = Euro

3 - Décimale
  • 0 = Pas de décimale, arrondi à 0.5=1 et 0.49 = 0
  • 1 = 2 décimales
  • Exemplo :

=EmTexto(B11;$G$1;$G$4;$G$7)

=EnTexte(B13;0;2;2)


Em razão do download o macro está disponível em ZIP, você deve primeiro descompactar. Nbrelettre.zip

Veja também

Artigo original publicado por . Tradução feita por ninha25. Última modificação: 19 de agosto de 2010 às 01:01 por ninha25.
Este documento, intitulado 'VB6/VBA Transformar números em letras (francês)', está disponível sob a licença Creative Commons. Você pode copiar e/ou modificar o conteúdo desta página com base nas condições estipuladas pela licença. Não se esqueça de creditar o CCM (br.ccm.net) ao utilizar este artigo.