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

 

  Fórum

  Visual Basic
Voltar
Autor Assunto:  Porcentagem por Extenso
João Paulo
ARCOS
MG - BRASIL
ENUNCIADA !
Postada em 23/04/2012 11:26 hs            
Pessoal alguem ja viu ou tem alguma rotina para escrever porcentagem por Extenso?
Ex.: 1,2% (Um Virgula dois porcento) séria + ou - assim.
   
J.Carlos
Pontos: 2843
PRESIDENTE PRUDENTE
SP - BRASIL
ENUNCIADA !
Postada em 23/04/2012 15:54 hs            
Peguei minha rotina de extenso pra outros valores e adaptei aí pra ti pro percentual, só que 1,2 na realidade é (um vírgula 20 por cento) ok?
 
txtvlExtenso.Text = Extenso2(txtValorRS.Text, "vírgula", "vírgula")
 
Public Function Extenso2(ByVal Valor As Double, ByVal MoedaPlural As String, ByVal 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 Extenso2 <> vbNullString Then
                        Parcial = Val(Mid(StrValor, Posicao, 3))
                        If Posicao = 16 And (Parcial < 100 Or (Parcial Mod 100) = 0) Then
                          Extenso2 = Extenso2 & " "
                        Else
                          Extenso2 = Extenso2 & ", "
                        End If
                    End If
                    Extenso2 = Extenso2 & buf
                End If
            End If
        Next
        If Extenso2 <> vbNullString Then
            If Negativo Then
                Extenso2 = "Menos " & Extenso2
            End If
            If Int(Valor) = 1 Then
                Extenso2 = Extenso2 & " " & MoedaSingular
            Else
                Extenso2 = Extenso2 & " " & MoedaPlural
            End If
        End If
        Parcial = Int((Valor - Int(Valor)) * 100 + 0.1)
        If Parcial Then
            buf = Extenso2(Parcial, "por cento", "por cento")
            If Extenso2 <> vbNullString Then
                Extenso2 = Extenso2 & " "
            End If
            Extenso2 = Extenso2 & buf
        Else
            Extenso2 = Replace(Extenso2, "vírgula", "por cento")
        End If
    End If
End Function
TÓPICO EDITADO
 
JOAO PAULO
não registrado
ENUNCIADA !
Postada em 23/04/2012 18:43 hs   
esta dando alguns erros onde em todas as linhas onde esta escrito "buf".
   
J.Carlos
Pontos: 2843
PRESIDENTE PRUDENTE
SP - BRASIL
ENUNCIADA !
Postada em 24/04/2012 08:46 hs            
Qual erro que está dando?
O seu projeto foi criado como standard ou como Vb Enterprise edition controls? Porque neste segundo ele já trás vários componentes. Pode ser que esteja faltando algum componente em seu projeto.
 
   
J.Carlos
Pontos: 2843
PRESIDENTE PRUDENTE
SP - BRASIL
ENUNCIADA !
Postada em 24/04/2012 09:01 hs            
João Paulo, achei o problema: Na realidade no post da rotina acima, não aparece a barra invertida "" coloquei o caracter % no lugar, Substitua o caracter % por Barra invertida, ok?
Abraços.
   
JOAO PAULO
não registrado
ENUNCIADA !
Postada em 24/04/2012 11:15 hs   
amigo ainda nao ta legal a rotina, exemplo se eu digitar 10 teria que sair por extenso assim (dez porcento) e esta saindo assim 10(Dez Mil Virgula)
Outro Exemplo: 1,5% esta saindo assim (Um Mil Virgula Cinquenta Mil porcento)
   
Página(s): 1/2      PRÓXIMA »


Seu Nome:

Seu eMail:

ALTERAR PARA MODO HTML
Mensagem:

[:)] = 
[:P] = 
[:(] = 
[;)] = 

HTML DESLIGADO

     
 VOLTAR

  



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