maio 25 2008

Função que gera números por extenso em Visual Basic

Vi uma pegadinha na Bugs 46, e fiquei intrigado a realiza-la em javascript, depois posto a problemática que o mestre Xião conseguiu desvendar. Mas ela é muito parecida com essa funçãozinha :

Public Function Extenso(ByVal Valor As _
       Double, ByVal MoedaPlural As _
       String, ByVal MoedaSingular As _
       String) As String
  Dim StrValor As String, Negativo As Boolean
  Dim Buf As String, Parcial As Integer
  Dim Posicao As Integer, Unidades
  Dim Dezenas, Centenas, PotenciasSingular
  Dim PotenciasPlural

  Negativo = (Valor < 0)
  Valor = Abs(CDec(Valor))
  If Valor Then
    Unidades = Array(vbNullString, “Um”, “Dois”, _
               “Três”, “Quatro”, “Cinco”, _
               “Seis”, “Sete”, “Oito”, “Nove”, _
               “Dez”, “Onze”, “Doze”, “Treze”, _
               “Quatorze”, “Quinze”, “Dezesseis”, _
               “Dezessete”, “Dezoito”, “Dezenove”)
    Dezenas = Array(vbNullString, vbNullString, _
              “Vinte”, “Trinta”, “Quarenta”, _
              “Cinqüenta”, “Sessenta”, “Setenta”, _
              “Oitenta”, “Noventa”)
    Centenas = Array(vbNullString, “Cento”, _
               “Duzentos”, “Trezentos”, _
               “Quatrocentos”, “Quinhentos”, _
               “Seiscentos”, “Setecentos”, _
               “Oitocentos”, “Novecentos”)
    PotenciasSingular = Array(vbNullString, ” Mil”, _
                        ” Milhão”, ” Bilhão”, _
                        ” Trilhão”, ” Quatrilhão”)
    PotenciasPlural = Array(vbNullString, ” Mil”, _
                      ” Milhões”, ” Bilhões”, _
                      ” Trilhões”, ” Quatrilhões”)

    StrValor = Left(Format(Valor, String(18, “0”) & _
               “.000”), 18)
    For Posicao = 1 To 18 Step 3
      Parcial = Val(Mid(StrValor, Posicao, 3))
      If Parcial Then
        If Parcial = 1 Then
          Buf = “Um” & PotenciasSingular((18 – _
                Posicao) \ 3)
        ElseIf Parcial = 100 Then
          Buf = “Cem” & PotenciasSingular((18 – _
                Posicao) \ 3)
        Else
          Buf = Centenas(Parcial \ 100)
          Parcial = Parcial Mod 100
          If Parcial <> 0 And Buf <> vbNullString Then
            Buf = Buf & ” e ”
          End If
          If Parcial < 20 Then
            Buf = Buf & Unidades(Parcial)
          Else
            Buf = Buf & Dezenas(Parcial \ 10)
            Parcial = Parcial Mod 10
            If Parcial <> 0 And Buf <> vbNullString Then
              Buf = Buf & ” e ”
            End If
            Buf = Buf & Unidades(Parcial)
          End If
          Buf = Buf & PotenciasPlural((18 – Posicao) \ 3)
        End If
        If Buf <> vbNullString Then
          If Extenso <> vbNullString Then
            Parcial = Val(Mid(StrValor, Posicao, 3))
            If Posicao = 16 And (Parcial < 100 Or _
                (Parcial Mod 100) = 0) Then
              Extenso = Extenso & ” e ”
            Else
              Extenso = Extenso & “, ”
            End If
          End If
          Extenso = Extenso & Buf
        End If
      End If
    Next
    If Extenso <> vbNullString Then
      If Negativo Then
        Extenso = “Menos ” & Extenso
      End If
      If Int(Valor) = 1 Then
        Extenso = Extenso & ” ” & MoedaSingular
      Else
        Extenso = Extenso & ” ” & MoedaPlural
      End If
    End If
    Parcial = Int((Valor – Int(Valor)) * _
              100 + 0.1)
    If Parcial Then
      Buf = Extenso(Parcial, “Centavos”, _
            “Centavo”)
      If Extenso <> vbNullString Then
        Extenso = Extenso & ” e ”
      End If
      Extenso = Extenso & Buf
    End If
  End If
End Function

 

Para usar a função só chama-la assim:

Dim sReturn As String
Dim dValor As Double
dValor = 10.00
sReturn = Extenso(dValor, “Reais”, “Real”)
MsgBox sReturn

 

Agradecimentos ao Gabriel Felipe por ter disponibilizado o código.



5 Comentários:

Trackbacks

  1. bruno diz:
    isso é muinto bom
    fevereiro 13th, 2009 às 2:24 am
  2. aaaa diz:
    doido
    abril 28th, 2009 às 8:45 pm
  3. nana diz:
    ta doido
    março 8th, 2010 às 5:47 pm
  4. Jussub Issa Omar diz:
    Yeah… era de um código assim que estava precisando para o meu projecto. . .
    obrigado pelo codigo e força ai continuem postando codigos dessa natureza que a gente agradece…valeu malta
    Maputo – Mozambique
    agosto 12th, 2010 às 8:23 pm
  5. Isaias diz:
    Poxa vida ……. nunca vi um codigo igual a esse. Parabens

    Brazil

    março 21st, 2011 às 6:43 pm

DEIXE UM COMENTÁRIO

Subscrever

Subscreve o Blog



Publicidade

Comentários Recentes

  • shirley Balazs: Parabéns!! Informações de utilidade publica e de primeira, foi muito útil a mim.Obrigada!!
  • Jefferson Ferreira de brito: eu quero muito
  • thiago valente: Eu quero um para mim
  • Lucas martins balieiro: Eu não fiz o enem mesmo assim eu posso me inscrever no site essa é minha dúvida, só queme...
  • Francisca Marli Oliveira: quero saber quanto tenho no meu fgts

Links

Leitores Recentes

VALE O CLIQUE!

Site Seguro Ocioso

Divulgue o blog Infomaroto em seu site e tenha seu link ou banner aqui.
Blog Infomaroto