Visual Basic em Português

Página pessoal de Jorge Paulino sobre o Visual Basic (VB.NET, ASP.NET, VB6, VBA) e algumas noticias de tecnologia

VB.NET: Converter Números para Extenso (Euros)

Muitos documentos oficiais requerem, além do valor em numérico, a descrição do valor por extenso. Por exemplo as facturas, notas de encomenda, cheques, etc. Não sei na verdade se é obrigatório mas um facto é que é quase sempre um requisito das aplicações.

Esta conversão obriga a um conjunto de cálculo e funções que chamam-se diversas vezes até construir o número completo.

alt

Para efectuar esta conversão é apenas necessário copiar estas funções para o programa.

  ''' <summary>
  ''' Função principal que recolhe o valor e chama as duas funções
  ''' auxiliares para a parte inteira e para a parte decimal
  ''' </summary>
  ''' <param name="number">Número a converter para extenso (Euros)</param>
  Public Function NumberToEuro(ByVal number As Decimal) As String
    Dim cent As Integer
    Try

      ' se for = 0 retorna 0 eros
      If number = 0 Then
        Return "Zero Euros"
      End If

      ' Verifica a parte decimal, ou seja, os cêntimos
      cent = Decimal.Round((number - Int(number)) * 100, _
                           MidpointRounding.ToEven)

      ' Verifica apenas a parte inteira
      number = Int(number)

      ' Caso existam cêntimos
      If cent > 0 Then

        ' Caso seja 1 não coloca "euros" mas sim "euro"
        If number = 1 Then
          Return "Um Euro e " & getDecimal(cent) & "Cêntimos"
          ' Caso o valor seja inferior a 1 euro
        ElseIf number = 0 Then
          Return getDecimal(cent) & "Cêntimos"
        Else
          Return getInteger(number) & "Euros e " & _
              getDecimal(cent) & "Cêntimos"
        End If

      Else
        ' Caso seja 1 não coloca "euros" mas sim "euro"
        If number = 1 Then
          Return "Um Euro"
        Else
          Return getInteger(number) + "Euros"
        End If

      End If

    Catch ex As Exception
      Return String.Empty
    End Try

  End Function


  ''' <summary>
  ''' Função auxiliar - Parte decimal a converter
  ''' </summary>
  ''' <param name="number">Parte decimal a converter</param>
  Public Function getDecimal(ByVal number As Byte) As String
    Try

      Select Case number
        Case 0
          Return String.Empty
        Case 1 To 19
          Dim strArray() As String = _
              {"Um", "Dois", "Três", "Quatro", "Cinco", "Seis", _
              "Sete", "Oito", "Nove", "Dez", "Onze", _
              "Doze", "Treze", "Quatorze", "Quinze", _
              "Dezasseis", "Dezassete", "Dezoito", "Dezanove"}
          Return strArray(number - 1) & " "

        Case 20 To 99
          Dim strArray() As String = _
              {"Vinte", "Trinta", "Quarenta", "Cinquenta", _
              "Sessenta", "Setenta", "Oitenta", "Noventa"}

          If (number Mod 10) = 0 Then
            Return strArray(number \ 10 - 2) & " "
          Else
            Return strArray(number \ 10 - 2) & " e " & _
                getDecimal(number Mod 10) & " "
          End If
        Case Else
          Return String.Empty
      End Select

    Catch ex As Exception
      Return String.Empty
    End Try
  End Function


  ''' <summary>
  ''' Função auxiliar - Parte inteira a converter
  ''' </summary>
  ''' <param name="number">Parte inteira a converter</param>
  Public Function getInteger(ByVal number As Decimal) As String
    Try

      number = Int(number)

      Select Case number
        Case Is < 0
          Return "-" & getInteger(-number)
        Case 0
          Return ""
        Case 1 To 19
          Dim strArray() As String = _
              {"Um", "Dois", "Três", "Quatro", "Cinco", "Seis", _
              "Sete", "Oito", "Nove", "Dez", "Onze", "Doze", _
              "Treze", "Quatorze", "Quinze", "Dezasseis", _
              "Dezassete", "Dezoito", "Dezanove"}
          Return strArray(number - 1) & " "

        Case 20 To 99
          Dim strArray() As String = _
              {"Vinte", "Trinta", "Quarenta", "Cinquenta", _
              "Sessenta", "Setenta", "Oitenta", "Noventa"}

          If (number Mod 10) = 0 Then
            Return strArray(number \ 10 - 2)
          Else
            Return strArray(number \ 10 - 2) & " e " & _
                getInteger(number Mod 10)
          End If

        Case 100
          Return "Cem"

        Case 101 To 999
          Dim strArray() As String = _
             {"Cento", "Duzentos", "Trezentos", "Quatrocentos", _
                  "Quinhentos", "Seiscentos", "Setecentos", _
                  "Oitocentos", "Novecentos"}

          If (number Mod 100) = 0 Then
            Return strArray(number \ 100 - 1) & " "
          Else
            Return strArray(number \ 100 - 1) & " e " & _
                getInteger(number Mod 100)
          End If


        Case 1000 To 1999
          Select Case (number Mod 1000)
            Case 0
              Return "Mil"
            Case Is <= 100
              Return "Mil e " & getInteger(number Mod 1000)
            Case Else
              Return "Mil, " & getInteger(number Mod 1000)
          End Select


        Case 2000 To 999999
          Select Case (number Mod 1000)
            Case 0
              Return getInteger(number \ 1000) & "Mil"
            Case Is <= 100
              Return getInteger(number \ 1000) & "Mil e " & _
                  getInteger(number Mod 1000)
            Case Else
              Return getInteger(number \ 1000) & "Mil, " & _
                  getInteger(number Mod 1000)
          End Select


        Case 1000000 To 1999999
          Select Case (number Mod 1000000)
            Case 0
              Return "Um Milhão"
            Case Is <= 100
              Return getInteger(number \ 1000000) & "Milhão e " & _
                  getInteger(number Mod 1000000)
            Case Else
              Return getInteger(number \ 1000000) & "Milhão, " & _
                  getInteger(number Mod 1000000)
          End Select


        Case 2000000 To 999999999
          Select Case (number Mod 1000000)
            Case 0
              Return getInteger(number \ 1000000) & " Milhões"
            Case Is <= 100
              Return getInteger(number \ 1000000) & "Milhões e " & _
                  getInteger(number Mod 1000000)
            Case Else
              Return getInteger(number \ 1000000) & "Milhões, " & _
                  getInteger(number Mod 1000000)
          End Select


        Case 1000000000 To 1999999999
          Select Case (number Mod 1000000000)
            Case 0
              Return "Um Bilião"
            Case Is <= 100
              Return getInteger(number \ 1000000000) & "Bilião e " & _
                  getInteger(number Mod 1000000000)
            Case Else
              Return getInteger(number \ 1000000000) & "Bilião, " & _
                  getInteger(number Mod 1000000000)
          End Select


        Case Else
          Select Case (number Mod 1000000000)
            Case 0
              Return getInteger(number \ 1000000000) & "Mil Milhões"

            Case Is <= 100
              Return getInteger(number \ 1000000000) & "Mil Milhões e " & _
                  getInteger(number Mod 1000000000)
            Case Else
              Return getInteger(number \ 1000000000) & "Mil Milhões, " & _
                  getInteger(number Mod 1000000000)
          End Select
      End Select


    Catch ex As Exception
      Return String.Empty
    End Try
  End Function


Para fazer a conversão é apenas necessário:

  Private Sub Converte()

    Me.txtResultado.Text = NumberToEuro(Me.txtOrigem.Text)

  End Sub

Basicamente são apenas cálculos repetitivos para construir uma frase com base em um número. Poderá parecer complicado mas na verdade é bastante simples e útil.

PS: Como sempre, qualquer dúvida, comentário ou correcção ao artigo é sempre bem vinda!

18 comentários:

Tchayvaz disse...

Excelente! Ainda não testei, mas parece que vai funcionar. Andei à procura de uma dll que contivesse a função ToWords() do Crystal Reports, mas em português, mas não deu em nada.

Vou converter este código á linguagem do Crystal Reports e aplicar no meu projecto.

Anónimo disse...

Excelente poupou-e imenso trabalho. Só duas correcções na função NumberToEuro, visto que se o valor for zero não retorna direito e o valor for inferior a 1 euro por exemplo 0.5€ também não retorna direito.

Public Function NumberToEuro(ByVal number As Decimal) As String
Dim cent As Integer
Try
' se for =0 retorna 0 eros
If number = 0 Then
Return "Zero Euros"
End If
' Verifica a parte decimal, ou seja, os cêntimos
cent = Decimal.Round((number - Int(number)) * 100, MidpointRounding.ToEven)
' Verifica apenas a parte inteira
number = Int(number)
' Caso existam cêntimos
If cent > 0 Then
' Caso seja 1 não coloca "euros" mas sim "euro"
If number = 1 Then
Return "Um Euro e " + getDecimal(cent) + "Cêntimos"
' Caso o valor seja inferior a 1 euro
ElseIf number = 0 Then
Return getDecimal(cent) + "Cêntimos"
Else
Return getInteger(number) + "Euros e " + getDecimal(cent) + "Cêntimos"
End If
Else
' Caso seja 1 não coloca "euros" mas sim "euro"
If number = 1 Then
Return "Um Euro"
Else
Return getInteger(number) + "Euros"
End If
End If
Catch ex As Exception
Return ""
End Try
End Function

Anónimo disse...

A verificação do singular Euro, não é necessária porque a palavra Euro não tem plural. Nunca se diz (ou pelo menos nunca se deve escrever) Euros, mas sempre Euro.
Bom trabalho.

Jorge Paulino disse...

Desconhecia completamente esse detalhe ... :)

Obrigado pela visita!

Lightning Zeus disse...

Consigo usar este código no excel ?? já tentei tudo mas não consegui....

Precisava de transformar numerico monetário para extenso. (ex. 1.000,00€ = Mil Euros)

Lightning

Anónimo disse...

Escelente este tópico.
Precisava de um semelhante para o VBA em access, alguem me pode arranjar?
Obrigado

Anónimo disse...

Obrigado, está excelente mas:
Os biliões estão à brasileira.
Em Portugal e alguns países da Europa
um bilião =1.000.000.000.000

1.000.000.000 deve ler-se mil milhões

Jorge Paulino disse...

Então mas não existe bilião ???

Bem, é só corrigir nesse ponto.

Anónimo disse...

Discordo em relação ao plurar no numerário por extenso.
Se fôr numerário(isto verificado no extrato de conta) o que aparece é em Euro. porque diz respeito a nºs ex: 10 Euro. , Se fôr por extenso (Acho eu) Escreve-se Dez Euros.

Unknown disse...

Muito bom, parabéns!
e obrigado

Anónimo disse...

Olá pessoal.
Resolvi aproveitar um pouco do código do JPaulino e modifica-lo de modo a que os bugs descritos anteriormente desaparecessem.
Caso alguém queira participar aqui fica o Link : http://stringtoolkit.codeplex.com/

Anónimo disse...

A consultar aos interessados : http://pt.wikipedia.org/wiki/Bilhão

Agosto disse...

Pois Eu usei e deu certo para um programinha que estou desenvolvendo para preencher os cheques de minha pequena empresa, so estou as voltas agora e com o MonthCalendar, pois não consigo tenho 3 textbox dia,mes e ano, para retornar as datas escolhidas.
Obrigado e boa tarde. Se alguêm poder ajudar desde já obrigado.Fernando

Jorge Paulino disse...

Olá Agostinho,

Coloque a sua questão no fórum da comunidade portugal-a-programar (com mais detalhes) ;)

Cumprimentos,
Jorge Paulino

Agosto disse...

Obrigado amigo Jorge já coloquei com mais detalhes. mais uma vez obrigado.Agostinho Fernando de Andrade

Unknown disse...

Deu mesmo jeito este código :-) Obrigado, Jorge!

Unknown disse...

Está a converter em extenso muito bem, no entanto bloqueia, aparece o valor por extenso e bloqueiam todos os botões, o que será??

Podem ajudar?

Geraldo Munguambe disse...

Muitíssimo Obrigado, popou-me muito tempo.
A única coisa que fiz foi alterar Euro para a moeda do meu país (o Metical)
thanks so much!



Microsoft Office Especialist

Membro da Comunidade
Experts-Exchange


Administ. da Comunidade
Portugal-a-Programar



Twitter

Artigos no CodeProject

Artigos no CodeProject
Google-Translate-ChineseGoogle-Translate-Portuguese to FrenchGoogle-Translate-Portuguese to GermanGoogle-Translate-Portuguese to ItalianGoogle-Translate-Portuguese to JapaneseGoogle-Translate-Portuguese to EnglishGoogle-Translate-Portuguese to RussianGoogle-Translate-Portuguese to Spanish

Subscrever Novidades

Endereço de Email:

Delivered by FeedBurner

Seguidores

Histórico