Vídeo recomendado
https://youtu.be/diWPPPhW-9E

Unidade de medida

Dúvidas gerais sobre Word
belgerson
Acabou de chegar
Acabou de chegar
Mensagens: 1
Registrado em: Qua Fev 08, 2012 11:40 am

Unidade de medida

Mensagem por belgerson »

Olá a todos.
Trabalho em cartório de notas e em algumas escrituras, preciso escrever metros por extenso, como por exemplo: 1.928,20 (hum mil, novecentos e vinte e oito metros e vinte centímetros).
Basicamente achei que poderia ter algo como a EXTENS32.DLL que escreve os valores por extenso.
Procurei por vários fóruns e achei algo aproximado, porem não sei rodar isto através de uma macro do word (sei criar e editar uma macro, mas na edição, copiar e colar a função abaixo, dá erro).
Se alguém puder ajudar verificando se esta macro funciona da forma acima e deixa-la pronta para o uso, agradeço imensamente.





Function VExtenso(NValor)
On Error GoTo 99
If IsNull(NValor) Or NValor > 9999999 Then
VExtenso = "# VALOR POR EXTENSO..............."

Exit Function
End If

If (NValor) < 0 Then
NValor = NValor * -1
End If

Dim nContador, nTamanho As Integer
Dim CValor, CPArte, CFinal, Etiq As String
ReDim aGrupo(4), aTexto(4) As String


ReDim aUnid(19) As String
aUnid(1) = "Um ": aUnid(2) = "Dois ": aUnid(3) = "Três "
aUnid(4) = "Quatro ": aUnid(5) = "Cinco ": aUnid(6) = "Seis "
aUnid(7) = "Sete ": aUnid(8) = "Oito ": aUnid(9) = "Nove "
aUnid(10) = "Dez ": aUnid(11) = "Onze ": aUnid(12) = "Doze "
aUnid(13) = "Treze ": aUnid(14) = "Quatorze ": aUnid(15) = "Quinze "
aUnid(16) = "Dezesseis ": aUnid(17) = "Dezessete ": aUnid(18) = "Dezoito "
aUnid(19) = "Dezenove "

ReDim aDezena(9) As String
aDezena(1) = "Dez ": aDezena(2) = "Vinte ": aDezena(3) = "Trinta "
aDezena(4) = "Quarenta ": aDezena(5) = "Cinquenta "
aDezena(6) = "Sessenta ": aDezena(7) = "Setenta ": aDezena(8) = "Oitenta "

aDezena(9) = "Noventa "

ReDim aCentena(9) As String
aCentena(1) = "Cento ": aCentena(2) = "Duzentos "
aCentena(3) = "Trezentos ": aCentena(4) = "Quatrocentos "
aCentena(5) = "Quinhentos ": aCentena(6) = "Seiscentos "
aCentena(7) = "Setecentos ": aCentena(8) = "Oitocentos "
aCentena(9) = "Novecentos "


CValor = Format$(NValor, "0000000000.00")
aGrupo(1) = Mid$(CValor, 2, 3)
aGrupo(2) = Mid$(CValor, 5, 3)
aGrupo(3) = Mid$(CValor, 8, 3)
aGrupo(4) = "0" + Mid$(CValor, 12, 2)


For nContador = 1 To 4
CPArte = aGrupo(nContador)
nTamanho = Switch(Val(CPArte) < 10, 1, Val(CPArte) < 100, 2, Val(CPArte) _
< 1000, 3)
If nTamanho = 3 Then
If Right$(CPArte, 2) <> "00" Then
aTexto(nContador) = aTexto(nContador) + aCentena(Left(CPArte, 1)) + _
"e "
nTamanho = 2
Else
aTexto(nContador) = aTexto(nContador) + IIf(Left$(CPArte, 1) = "1", _
"CEM ", aCentena(Left(CPArte, 1)))
End If
End If
If nTamanho = 2 Then
If Val(Right(CPArte, 2)) < 20 Then
aTexto(nContador) = aTexto(nContador) + aUnid(Right(CPArte, 2))
Else
aTexto(nContador) = aTexto(nContador) + aDezena(Mid(CPArte, 2, 1))
If Right$(CPArte, 1) <> "0" Then
aTexto(nContador) = aTexto(nContador) + "e "
nTamanho = 1
End If
End If
End If
If nTamanho = 1 Then
aTexto(nContador) = aTexto(nContador) + aUnid(Right(CPArte, 1))
End If
Next


If Val(aGrupo(1) + aGrupo(2) + aGrupo(3)) = 0 And Val(aGrupo(4)) <> 0 Then
CFinal = aTexto(4) + IIf(Val(aGrupo(4)) = 1, "centímetro", "centímetros")

Else
CFinal = ""
CFinal = CFinal + IIf(Val(aGrupo(1)) <> 0, aTexto(1) + _
IIf(Val(aGrupo(1)) > 1, "milhões ", "milhão "), "")
If Val(aGrupo(2) + aGrupo(3)) = 0 Then
CFinal = CFinal + "de "

Else
CFinal = CFinal + IIf(Val(aGrupo(2)) >= 1, aTexto(2) + "mil ", "")
End If

CFinal = CFinal + aTexto(3) + IIf(Val(aGrupo(1) + aGrupo(2) + aGrupo(3)) _
= 1, "metro ", "metros ")
CFinal = CFinal + IIf(Val(aGrupo(4)) <> 0, "e " + aTexto(4) + _
IIf(Val(aGrupo(4)) = 1, "centímetro", "centímetros"), "")
End If
VExtenso = CFinal

If NValor > 2 And NValor < 2000 And Left(VExtenso, 2) = "um" Then
VExtenso = Mid(VExtenso, 4, 250)

Else
VExtenso = CFinal
End If
Exit Function
99:
VExtenso = "# ERRO DE VALOR"
Exit Function

End Function


End Function
End Sub


Disable adblock

This site is supported by ads and donations.
If you see this text you are blocking our ads.
Please consider a Donation to support the site.


Avatar do usuário
webmaster
Administrador
Mensagens: 3114
Registrado em: Sex Jul 24, 2009 2:44 pm
Contato:

Re: Unidade de medida

Mensagem por webmaster »

Colega,

Essa função não ajuda?

http://www.tomasvasquez.com.br/blog/mic ... or-extenso

Pode ser usada no Word também.

Abraços


Responder