NÚMEROS POR EXTENSO NO EXCEL (COM VBA)

Hoje, ao passear pela página de tecnologia  do UOL, encontrei uma matéria interessante com algumas dicas para uso do EXCEL.
A primeira delas faz uso do VBA (visual basic for applications), uma poderosa ferramenta do MS OFFICE que permite criar nossas próprias funções para uso no EXCEL, WORD, ACCESS, etc.
A dica trata de uma FUNÇÃO EM VBA que “escreve” um dado número como unidade monetária por extenso.
Em um momento, o site permite baixar um arquivo com o programa completo.
Notei que há um pequeno erro, uma letra faltando no início do código o que, na prática, inviabiliza seu uso sem a devida correção.
Portanto, resolvi reeditar a matéria aqui, mas não sem deixar claro que o conteúdo original encontra-se no site http://tecnologia.uol.com.br/dicas/ultnot/2008/06/16/ult2665u343.jhtm.

Mãos à obra:

Abra uma nova pasta do MS EXCEL.
Clique no menu FERRAMENTAS, opção MACRO, item EDITOR DO VISUAL BASIC.

Na janela
apresentada, clique com o botão direito do mouse sobre a descrição do projeto (VBA PROJECT…), escolha INSERIR e MÓDULO.

Será exibido um item MÓDULO, com uma área de edição do lado direito. Copie e cole a FUNÇÃO ABAIXO (no fim do post) na área de edição do módulo.

Clique no botão SALVAR (ou CTRL+B).
Feche o editor do VISUAL BASIC e retorne à planílha do EXCEL.
Na célula A1, digite um valor numérico (123,45) e tecle enter.
Selecione a célula B1, clique no menu INSERIR, item FUNÇÃO.
Será exibida uma janela para seleção das funções disponíveis. Na opção CATEGORIA, selecione DEFINIDA PELO USUÁRIO.

Será exibida uma função EXTENSO na caixa de seleção. Clique sobre ela e clique em OK.
Na janela seguinte, ARGUMENTOS DA FUNÇÃO, informe A1 no campo nValor e clique em OK.

O valor por extenso deverá ser exibido na célula B1.

Para testar, altere o valor na célula A1. O valor por extenso em B1 deverá ser alterado automaticamente.
Clique a seguir para baixar o arquivo TXT com o código: Download
OBSERVAÇÃO: Esta função suporta valores até 999.999,99
Código da função:
Function EXTENSO(nValor)
On Error GoTo 99
If IsNull(nValor) Or nValor > 9999999 Then
EXTENSO = “# 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) = “Ointenta ”
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, “centavo”, “centavos”)
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, “real “, “reais “)
CFinal = CFinal + IIf(Val(aGrupo(4)) <> 0, “e ” + aTexto(4) + _
IIf(Val(aGrupo(4)) = 1, “centavo”, “centavos”), “”)
End If
EXTENSO = CFinal
If nValor > 2 And nValor < 2000 And Left(EXTENSO, 2) = “UM” Then
EXTENSO = Mid(EXTENSO, 4, 250)
Else
EXTENSO = CFinal
End If
Exit Function
99:
EXTENSO = “# ERRO DE VALOR”
Exit Function
End Function




OS COMENTÁRIOS AJUDAM MUITO E INCENTIVAM, PORTANTO NÃO DEIXE DE FAZER O SEU!