|
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
|
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
|
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
|
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)
|
|
|
|