expresiones en texto de valores

Esta pregunta no se ha hecho nunca en este foro (ejem, ejem...)
Por lo tanto te pongo mi solución fruto de un refrito de alguien (juro que
no recuerdo quien) que es autor del 99% de este código:
CNAL= ConvierteNúmeroALetra
Contempla los decimales, las cifras negativas y utiliza la palabra Euro/s,
pues es para lo que yo utilizo esta función.

En un módulo del libro inserta este código:

Public Function CNAL(Numero)
Dim Texto
Dim Millones
Dim Miles
Dim Cientos
Dim Decimales
Dim Cadena
Dim CadMillones
Dim CadMiles
Dim CadCientos
Dim caddecimales
Dim Signo
If Numero < 0 Then
Signo = "MENOS "
End If
Numero = Abs(Numero)
Texto = Numero
Texto = FormatNumber(Texto, 2)
Texto = Right(Space(14) & Texto, 14)
If Int(Numero) > 999999999 Then
CNAL = "No se puede convertir este número, solo se soporta el siguiente
formato: 999.999.999,99"
Exit Function
End If
Millones = Mid(Texto, 1, 3)
Miles = Mid(Texto, 5, 3)
Cientos = Mid(Texto, 9, 3)
Decimales = Mid(Texto, 13, 2)
CadMillones = conviertecifra(Millones)
CadMiles = conviertecifra(Miles)
CadCientos = conviertecifra(Cientos)
caddecimales = conviertedecimal(Decimales)
If Trim(CadMillones) > "" Then
If Trim(CadMillones) = "UN" Then
Cadena = CadMillones & " MILLON "
Else
Cadena = CadMillones & " MILLONES "
End If
End If
If Trim(CadMiles) > "" Then
If Trim(CadMiles) = "UN" Then
CadMiles = ""
Cadena = Cadena & "" & CadMiles & " MIL "
Else
Cadena = Cadena & " " & CadMiles & " MIL "
End If
End If


If Decimales = "00" Then
If Millones <> 0 And Miles = 0 And Cientos = 0 Then
Cadena = Cadena & " DE EUROS"
Else
If Int(Numero) > 1 Then
Cadena = Cadena & " " & Trim(CadCientos) & " EUROS "
Else
If Int(Numero) = 1 Then
Cadena = Cadena & " " & Trim(CadCientos) & " EURO "
End If
End If
End If
Else
If Millones <> 0 And Miles = 0 And Cientos = 0 Then
Cadena = Cadena & " DE EUROS"
Else
If Int(Numero) > 1 Then
Cadena = Cadena & " " & Trim(CadCientos) & " EUROS "
Else
If Int(Numero) = 1 Then
Cadena = Cadena & " " & Trim(CadCientos) & " EURO "
End If
End If
End If
If Int(Decimales) > 1 And Int(Numero) <> 0 Then
Cadena = Cadena & "CON " & Trim(caddecimales) & " CÉNTIMOS"
Else
If Int(Decimales) > 1 And Int(Numero) = 0 Then
Cadena = Cadena & Trim(caddecimales) & " CÉNTIMOS"
Else
If Int(Decimales) = 1 And Int(Numero) <> 0 Then
Cadena = Cadena & " Y UN CÉNTIMO"
End If
If Int(Decimales) = 1 And Int(Numero) = 0 Then
Cadena = Cadena & "UN CÉNTIMO"
End If
End If
End If
End If
CNAL = "#" & Signo & Trim(Cadena) & "#"
End Function


Function conviertecifra(Texto)
Dim Centena
Dim Decena
Dim Unidad
Dim txtCentena
Dim txtDecena
Dim txtUnidad
Centena = Mid(Texto, 1, 1)
Decena = Mid(Texto, 2, 1)
Unidad = Mid(Texto, 3, 1)
Select Case Centena
Case "1"
txtCentena = "CIEN"
If Decena & Unidad <> "00" Then
txtCentena = "CIENTO"
End If
Case "2"
txtCentena = "DOSCIENTOS"
Case "3"
txtCentena = "TRESCIENTOS"
Case "4"
txtCentena = "CUATROCIENTOS"
Case "5"
txtCentena = "QUINIENTOS"
Case "6"
txtCentena = "SEISCIENTOS"
Case "7"
txtCentena = "SETECIENTOS"
Case "8"
txtCentena = "OCHOCIENTOS"
Case "9"
txtCentena = "NOVECIENTOS"
End Select


Select Case Decena
Case "1"
txtDecena = "DIEZ"
Select Case Unidad
Case "1"
txtDecena = "ONCE"
Case "2"
txtDecena = "DOCE"
Case "3"
txtDecena = "TRECE"
Case "4"
txtDecena = "CATORCE"
Case "5"
txtDecena = "QUINCE"
Case "6"
txtDecena = "DIECISEIS"
Case "7"
txtDecena = "DIECISIETE"
Case "8"
txtDecena = "DIECIOCHO"
Case "9"
txtDecena = "DIECINUEVE"
End Select


Case "2"
txtDecena = "VEINTE"
If Unidad <> "0" Then
txtDecena = "VEINTI"
End If
Case "3"
txtDecena = "TREINTA"
If Unidad <> "0" Then
txtDecena = "TREINTA Y "
End If
Case "4"
txtDecena = "CUARENTA"
If Unidad <> "0" Then
txtDecena = "CUARENTA Y "
End If
Case "5"
txtDecena = "CINCUENTA"
If Unidad <> "0" Then
txtDecena = "CINCUENTA Y "
End If
Case "6"
txtDecena = "SESENTA"
If Unidad <> "0" Then
txtDecena = "SESENTA Y "
End If
Case "7"
txtDecena = "SETENTA"
If Unidad <> "0" Then
txtDecena = "SETENTA Y "
End If
Case "8"
txtDecena = "OCHENTA"
If Unidad <> "0" Then
txtDecena = "OCHENTA Y "
End If
Case "9"
txtDecena = "NOVENTA"
If Unidad <> "0" Then
txtDecena = "NOVENTA Y "
End If
End Select


If Decena <> "1" Then
Select Case Unidad
Case "1"
txtUnidad = "UN"
Case "2"
txtUnidad = "DOS"
Case "3"
txtUnidad = "TRES"
Case "4"
txtUnidad = "CUATRO"
Case "5"
txtUnidad = "CINCO"
Case "6"
txtUnidad = "SEIS"
Case "7"
txtUnidad = "SIETE"
Case "8"
txtUnidad = "OCHO"
Case "9"
txtUnidad = "NUEVE"
End Select
End If


conviertecifra = txtCentena & " " & txtDecena & txtUnidad
End Function


Function conviertedecimal(Texto)
Dim Decenadecimal
Dim Unidaddecimal
Dim txtDecenadecimal
Dim txtUnidaddecimal
Decenadecimal = Mid(Texto, 1, 1)
Unidaddecimal = Mid(Texto, 2, 1)


Select Case Decenadecimal
Case "1"
txtDecenadecimal = "DIEZ"
Select Case Unidaddecimal
Case "1"
txtDecenadecimal = "ONCE"
Case "2"
txtDecenadecimal = "DOCE"
Case "3"
txtDecenadecimal = "TRECE"
Case "4"
txtDecenadecimal = "CATORCE"
Case "5"
txtDecenadecimal = "QUINCE"
Case "6"
txtDecenadecimal = "DIECISEIS"
Case "7"
txtDecenadecimal = "DIECISIETE"
Case "8"
txtDecenadecimal = "DIECIOCHO"
Case "9"
txtDecenadecimal = "DIECINUEVE"
End Select
Case "2"
txtDecenadecimal = "VEINTE"
If Unidaddecimal <> "0" Then
txtDecenadecimal = "VEINTI"
End If
Case "3"
txtDecenadecimal = "TREINTA"
If Unidaddecimal <> "0" Then
txtDecenadecimal = "TREINTA Y "
End If
Case "4"
txtDecenadecimal = "CUARENTA"
If Unidaddecimal <> "0" Then
txtDecenadecimal = "CUARENTA Y "
End If
Case "5"
txtDecenadecimal = "CINCUENTA"
If Unidaddecimal <> "0" Then
txtDecenadecimal = "CINCUENTA Y "
End If
Case "6"
txtDecenadecimal = "SESENTA"
If Unidaddecimal <> "0" Then
txtDecenadecimal = "SESENTA Y "
End If
Case "7"
txtDecenadecimal = "SETENTA"
If Unidaddecimal <> "0" Then
txtDecenadecimal = "SETENTA Y "
End If
Case "8"
txtDecenadecimal = "OCHENTA"
If Unidaddecimal <> "0" Then
txtDecenadecimal = "OCHENTA Y "
End If
Case "9"
txtDecenadecimal = "NOVENTA"
If Unidaddecimal <> "0" Then
txtDecenadecimal = "NOVENTA Y "
End If
End Select


If Decenadecimal <> "1" Then
Select Case Unidaddecimal
Case "1"
txtUnidaddecimal = "UN"
Case "2"
txtUnidaddecimal = "DOS"
Case "3"
txtUnidaddecimal = "TRES"
Case "4"
txtUnidaddecimal = "CUATRO"
Case "5"
txtUnidaddecimal = "CINCO"
Case "6"
txtUnidaddecimal = "SEIS"
Case "7"
txtUnidaddecimal = "SIETE"
Case "8"
txtUnidaddecimal = "OCHO"
Case "9"
txtUnidaddecimal = "NUEVE"
End Select
End If
If Decenadecimal = 0 And Unidaddecimal = 0 Then
conviertedecimal ""
Else
conviertedecimal = txtDecenadecimal & txtUnidaddecimal
End If
End Function

"hengar58" escribió en el mensaje
news:

Tengo un valor de 5946, como puedo hacer que en otra celda aparezca por
funcion o formula en forma de texto es decir "cinco mil novecientos
cuarenta
y seis".