USUÁRIO:      SENHA:        SALVAR LOGIN ?    Adicione o VBWEB na sua lista de favoritos   Fale conosco 

 

  Dicas

  Visual Basic    (Datas/Números/Strings)

Título da Dica:  Escreve valores por extenso
Postada em 14/7/2003 por Everest            
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:

CODE  
Private Sub Command1_Click()

   Me.Text2.Text = Extenso(Me.Text1.Text, "Reais", "Real")
  
End Sub

 


CyberWEB Network Ltda.    © Copyright 2000-2024   -   Todos os direitos reservados.
Powered by HostingZone - A melhor hospedagem para seu site
Topo da página