Funció VBA per posar els números en català a l’Excel

L’Excel no té una funció per escriure els números en lletres, i de molt poques llengües en circulen per la xarxa solucions a mida. Fa anys, quan fèiem rebuts amb l’import en lletres em vaig cansar de canviar a mà la quantitat cada vegada que canviàvem alguna cosa de la factura i vaig fer-me una funció per escriure els números. No està especialment ben feta perquè va ser el meu primer programa amb VBA però funciona.

Per fer servir la funció la podeu copiar en cada llibre on la vulgueu fer servir i pot ser que per executar-les hàgiu de modificar la seguretat de les macros, i amb les darreres versions d’Excel haureu de guardar el llibre com a llibre habilitat per a macros.

  • Amb el llibre obert, obriu l’editor de Visual Basic amb ALT+F11.
  • Seleccioneu Insertar>Mòdul. Apareixerà un full en blanc.
  • Copieu-hi el text del codi que ve a continuació:
'Unitats del 1 al 9
Public Function unitat(num)

numb = unitats(num)
If numb = 0 Then
unitat = ""
Else
unitat = Choose(numb, "UN", "DOS", "TRES", "QUATRE", "CINC", "SIS", "SET", "VUIT", "NOU")

End If

End Function

'Valor de la xifra en una posició
Public Function xifra(num, pos)

intmes = Int(num / 10 ^ (pos + 1)) * 10
intnum = Int(num / 10 ^ pos)
xifra = intnum - intmes

End Function

'Desenes en lletra
Public Function desena(num)

numb = xifra(num, 1)
If numb = 0 Then
desena = ""
Else
desena = Choose(numb, "DEU", "VINT", "TRENTA", "QUARANTA", "CINQUANTA", "SEIXANTA", "SETANTA", "VUITANTA", "NORANTA", "CENT")
End If

End Function

'Separador entre la desena i la unitat
Public Function separa(num)

numb = talla99(num)
If xifra(numb, 0) = 0 Then
separa = ""
ElseIf numb > 30 Then
separa = "-"
Else
separa = "-I-"
End If

End Function

'Darreres dos xifres del número
Public Function talla99(num)

talla99 = Int(num) - 100 * Int(num / 100)

End Function

'Centena en lletres
Public Function centena(num)

cent = xifra(num, 2)
If cent = 0 Then
centena = ""
ElseIf cent = 1 Then
centena = "CENT"
Else
centena = unitat(cent) & "-CENTS"
End If

End Function

'Número de tres xifres en lletres
Public Function Num999(num)

Num999 = centena(num) & separacent(num) & num99(num)

End Function

'Darrera xifra del número
Public Function unitats(num)

unitats = xifra(num, 0)

End Function

'Separació darrera les centenes
Public Function separacent(num)

If xifra(num, 2) = 0 Or talla99(num) = 0 Then
separacent = ""
Else
separacent = " "
End If

End Function

'Nombres fins al 20 en lletres
Public Function num20(num)

numb = talla99(num)
If numb = 0 Then
num20 = ""
Else
num20 = Choose(numb, "UN", "DOS", "TRES", "QUATRE", "CINC", "SIS", "SET", "VUIT", "NOU", "DEU", "ONZE", "DOTZE", "TRETZE", "CATORZE", "QUINZE", "SETZE", "DISSET", "DIVUIT", "DINOU", "VINT")

End If

End Function

'Nombres fins al 100 en lletres
Public Function num99(num)

numb = talla99(num)
If numb < 20 
Then 
num99 = num20(numb) 
Else 
num99 = desena(numb) & separa(numb) & unitat(numb) 
End If 

End Function 

'Nombres fins al 999.999 en lletres 
Public Function nummil(num) 
miln = Int(num / 1000) 
resta = Int(num) - miln * 1000 
If resta > 0 
Then
restax = " " & Num999(num)
Else
restax = ""
End If
If miln = 0 Then
nummil = Num999(num)
ElseIf miln = 1 Then
nummil = "MIL" & restax
ElseIf miln > 1 Then
nummil = Num999(miln) & " MIL" & restax
End If

End Function

'Nombres fins al 999.999.999.999 en lletres en masculí
Public Function nummilio(num)

miln = Int(num / 1000000)
resta = Int(num) - miln * 1000000
If resta > 0 Then
restax = " " & nummil(num)
Else
restax = ""
End If
If miln = 0 Then
nummilio = nummil(num)
ElseIf miln = 1 Then
nummilio = "UN MILIÓ" & restax
ElseIf miln > 1 Then
nummilio = nummil(miln) & " MILIONS" & restax
End If

End Function

'Unitats en lletres en femení
Public Function unitatfem(num)

numb = unitats(num)
If numb = 0 Then
unitatfem = ""
Else
unitatfem = Choose(numb, "UNA", "DUES", "TRES", "QUATRE", "CINC", "SIS", "SET", "VUIT", "NOU")

End If

End Function

'Nombres fins al 20 en femení
Public Function num20fem(num)

numb = talla99(num)
If numb = 0 Then
num20fem = ""
Else
num20fem = Choose(numb, "UNA", "DUES", "TRES", "QUATRE", "CINC", "SIS", "SET", "VUIT", "NOU", "DEU", "ONZE", "DOTZE", "TRETZE", "CATORZE", "QUINZE", "SETZE", "DISSET", "DIVUIT", "DINOU", "VINT")

End If

End Function

'Nombres fins al 99 en femení
Public Function num99fem(num)

numb = talla99(num)
If numb < 20 
Then 
num99fem = num20fem(numb) 
Else 
num99fem = desena(numb) & separa(numb) & unitatfem(numb) 
End If 

End Function 

'Centenes en lletres en femení 
Public Function centenafem(num) cent = xifra(num, 2) 
If cent = 0 
Then 
centenafem = "" 
ElseIf cent = 1 
Then centenafem = "CENT" 
Else centenafem = unitatfem(cent) & "-CENTES" 
End If 

End Function 

'Nombres fins al 999 en femení 
Public Function Num999fem(num) 
Num999fem = centenafem(num) & separacent(num) & num99fem(num) 

End Function 'Milers en lletres en femení Public Function nummilfem(num) miln = Int(num / 1000) resta = Int(num) - miln * 1000 If resta > 0 Then
restax = " " & Num999fem(num)
Else
restax = ""
End If
If miln = 0 Then
nummilfem = Num999fem(num)
ElseIf miln = 1 Then
nummilfem = "MIL" & restax
ElseIf miln > 1 Then
nummilfem = Num999fem(miln) & " MIL" & restax
End If

End Function

'Nombres fins al 999.999.999.999 en lletres en femení
Public Function nummiliofem(num)

miln = Int(num / 1000000)
resta = Int(num) - miln * 1000000
If resta > 0 Then
restax = " " & nummilfem(num)
Else
restax = ""
End If
If miln = 0 Then
nummiliofem = nummilfem(num)
ElseIf miln = 1 Then
nummiliofem = "UN MILIÓ" & restax
ElseIf miln > 1 Then
nummiliofem = nummil(miln) & " MILIONS" & restax
End If

End Function

'Quantitats de pessetes en lletres
Public Function pessetes(num)

miln = Int(num / 1000000)
resta = Int(num) - miln * 1000000
If resta > 0 Then
pessetes = nummiliofem(num) & " pessetes"
ElseIf miln > 0 Then
pessetes = nummiliofem(num) & " de pessetes"
Else
pessetes = "ZERO pessetes"
End If

End Function

'Quantitats d'euros en lletres
Public Function euros(num)

miln = Int(num / 1000000)
resta = Int(num) - miln * 1000000
If resta > 0 Then
euros = nummilio(num) & " euros"
ElseIf miln > 0 Then
euros = nummilio(num) & " d'euros"
Else
euros = "ZERO euros"
End If
cent = num - Int(num)
cent = Int(cent * 100 + 0.5)
If cent > 0 Then
euros = euros & " amb " & nummilio(cent) & " cèntims"
End If

End Function

Amb això tindreu quatre funcions:

  • nummilio: els números en masculí
  • nummiliofem: els números en femení
  • euros: un import en euros i cèntims en lletres
  • pessetes: un import en pessetes en lletres

Exemples d’ús:

=nummilio(99987889789,22)

NORANTA-NOU MIL NOU-CENTS VUITANTA-SET MILIONS VUIT-CENTS VUITANTA-NOU MIL SET-CENTS VUITANTA-NOU

=nummiliofem(99987889789,22)

NORANTA-NOU MIL NOU-CENTS VUITANTA-SET MILIONS VUIT-CENTES VUITANTA-NOU MIL SET-CENTES VUITANTA-NOU

=euros(99987889789,22)

NORANTA-NOU MIL NOU-CENTS VUITANTA-SET MILIONS VUIT-CENTS VUITANTA-NOU MIL SET-CENTS VUITANTA-NOU euros amb VINT-I-DOS cèntims

=pessetes(99987889789,22)

NORANTA-NOU MIL NOU-CENTS VUITANTA-SET MILIONS VUIT-CENTES VUITANTA-NOU MIL SET-CENTES VUITANTA-NOU pessetes

Totes les funcions funcionen amb números inferiors al bilió i, excepte la funció euros, ignoren els decimals.

Si heu d’adaptar la funció a un altre idioma us suggereixo simplificar una mica el codi reescrivint la funció num99 (i num99fem si necessiteu números en femení) per que no faci servir funcions auxiliars, i així no haver-les d’adaptar. Podeu fer servir de mostra la funció num20 per posar una instrucció Case amb la llista de tots els números fins al noranta-nou. Així haureu d’escriure més però haureu de programar menys.

 

Anuncis

Deixa un comentari

Fill in your details below or click an icon to log in:

WordPress.com Logo

Esteu comentant fent servir el compte WordPress.com. Log Out / Canvia )

Twitter picture

Esteu comentant fent servir el compte Twitter. Log Out / Canvia )

Facebook photo

Esteu comentant fent servir el compte Facebook. Log Out / Canvia )

Google+ photo

Esteu comentant fent servir el compte Google+. Log Out / Canvia )

Connecting to %s