Números a Letras con Código VBA Access

Estoy modificando el siguiente código pero necesito que cuando utilice el numero 1000000 ponga "Un Millón" de pesos.

Function Extenso(nValor As String) As String

'Faz a validação do argumento
If IsNull(nValor) Or nValor > 999999999.99 Then Exit Function

'Declara as variáveis da função
Dim intContador As Integer
Dim intTamanho As Integer
Dim strValor As String
Dim strParte As String
Dim strFinal As String
Dim strGrupo(4) As String
Dim strTexto(4) As String

'Define matrizes com extensos parciais
Dim strUnid(19) As String
strUnid(1) = " ": strUnid(2) = "dos ": strUnid(3) = "tres ": strUnid(4) = "cuatro ": strUnid(5) = "cinco ": strUnid(6) = "seis ": strUnid(7) = "siete ": strUnid(8) = "ocho ": strUnid(9) = "nueve ": strUnid(10) = "diez ": strUnid(11) = "once ": strUnid(12) = "doce ": strUnid(13) = "trece ": strUnid(14) = "catorce ": strUnid(15) = "quince ": strUnid(16) = "dieciseis ": strUnid(17) = "diecisiete ": strUnid(18) = "dieciocho ": strUnid(19) = "diecinueve "
Dim strDezena(9) As String
strDezena(1) = "diez ": strDezena(2) = "veinte ": strDezena(3) = "treinta ": strDezena(4) = "cuarenta ": strDezena(5) = "cincuenta ": strDezena(6) = "sesenta ": strDezena(7) = "setenta ": strDezena(8) = "ochenta ": strDezena(9) = "noventa "
Dim strCentena(9) As String
strCentena(1) = "cientos ": strCentena(2) = "doscientos ": strCentena(3) = "trecientos ": strCentena(4) = "cuatrocientos ": strCentena(5) = "quinientos ": strCentena(6) = "seiscientos ": strCentena(7) = "setecientos ": strCentena(8) = "ochocientos ": strCentena(9) = "novecientos "

'Divide o valor em vários grupos
strValor = Format$(nValor, "0000000000.00")
strGrupo(1) = Mid$(strValor, 2, 3) 'Milhão
strGrupo(2) = Mid$(strValor, 5, 3) 'Milhar
strGrupo(3) = Mid$(strValor, 8, 3) 'Centena
strGrupo(4) = "0" + Mid$(strValor, 12, 2) 'Centavo

'Processa cada grupo
For intContador = 1 To 4
strParte = strGrupo(intContador)

IntTamanho = Switch(Val(strParte) < 10, 1, Val(strParte) < 100, 2, Val(strParte) < 1000, 3)
If intTamanho = 3 Then
If Right$(strParte, 2) <> "00" Then
strTexto(intContador) = strTexto(intContador) + strCentena(Left(strParte, 1)) + " " 'con
intTamanho = 2
Else
strTexto(intContador) = strTexto(intContador) + IIf(Left$(strParte, 1) = "1", "cien ", strCentena(Left(strParte, 1)))
End If
End If

If intTamanho = 2 Then
If Val(Right(strParte, 2)) < 20 Then
strTexto(intContador) = strTexto(intContador) + strUnid(Right(strParte, 2))
Else
strTexto(intContador) = strTexto(intContador) + strDezena(Mid(strParte, 2, 1))
If Right$(strParte, 1) <> "0" Then
strTexto(intContador) = strTexto(intContador) + "y "
intTamanho = 1
End If
End If
End If

If intTamanho = 1 Then
strTexto(intContador) = strTexto(intContador) + strUnid(Right(strParte, 1))
End If
Next intContador

'Gera o formato final do texto
If Val(strGrupo(1) + strGrupo(2) + strGrupo(3)) = 0 And Val(strGrupo(4)) <> 0 Then
strFinal = strTexto(4) + IIf(Val(strGrupo(4)) = 1, "centavo", "centavos")
Else
strFinal = ""
If Val(strGrupo(2)) = 0 And Val(strGrupo(3)) = 0 And Val(strGrupo(4)) = 0 Then
strFinal = strFinal + IIf(Val(strGrupo(1)) <> 0, strTexto(1) + IIf(Val(strGrupo(1)) > 1, "millones de ", "millon de "), "")
End If
If Val(strGrupo(2)) <> 0 And Val(strGrupo(3)) = 0 And Val(strGrupo(4)) = 0 Then
strFinal = strFinal + IIf(Val(strGrupo(1)) <> 0, strTexto(1) + IIf(Val(strGrupo(1)) > 1, "millones ", "millones "), "")
End If
If Val(strGrupo(2)) = 0 And Val(strGrupo(3)) <> 0 And Val(strGrupo(4)) = 0 Then
strFinal = strFinal + IIf(Val(strGrupo(1)) <> 0, strTexto(1) + IIf(Val(strGrupo(1)) > 1, "millones ", "millones "), "")
End If
If Val(strGrupo(2)) <> 0 And Val(strGrupo(3)) <> 0 And Val(strGrupo(4)) = 0 Then
strFinal = strFinal + IIf(Val(strGrupo(1)) <> 0, strTexto(1) + IIf(Val(strGrupo(1)) > 1, "millones, ", "millones, "), "")
End If
If Val(strGrupo(2)) <> 0 And Val(strGrupo(3)) <> 0 And Val(strGrupo(4)) <> 0 Then
strFinal = strFinal + IIf(Val(strGrupo(1)) <> 0, strTexto(1) + IIf(Val(strGrupo(1)) > 1, "millones, ", "millones, "), "")
End If
If Val(strGrupo(2)) <> 0 And Val(strGrupo(3)) = 0 And Val(strGrupo(4)) <> 0 Then
strFinal = strFinal + IIf(Val(strGrupo(1)) <> 0, strTexto(1) + IIf(Val(strGrupo(1)) > 1, "millones, ", "millones, "), "")
End If
If Val(strGrupo(2)) = 0 And Val(strGrupo(3)) = 0 And Val(strGrupo(4)) <> 0 Then
strFinal = strFinal + IIf(Val(strGrupo(1)) <> 0, strTexto(1) + IIf(Val(strGrupo(1)) > 1, "millones de ", "millones de "), "")
End If
If Val(strGrupo(2)) = 0 And Val(strGrupo(3)) <> 0 And Val(strGrupo(4)) <> 0 Then
strFinal = strFinal + IIf(Val(strGrupo(1)) <> 0, strTexto(1) + IIf(Val(strGrupo(1)) > 1, "millones, ", "millones, "), "")
End If
If Val(strGrupo(3)) = 0 Then
strFinal = strFinal + IIf(Val(strGrupo(2)) <> 0, strTexto(2) + "mil ", "")
Else
If Val(strGrupo(4)) = 0 Then
strFinal = strFinal + IIf(Val(strGrupo(2)) <> 0, strTexto(2) + "mil con ", "")
Else
strFinal = strFinal + IIf(Val(strGrupo(2)) <> 0, strTexto(2) + "mil, ", "")
End If
End If
If Val(strGrupo(4)) = 0 Then
strFinal = strFinal + strTexto(3) + IIf(Val(strGrupo(1) + strGrupo(2) + strGrupo(3)) = 1, "pesos ", "pesos ")
Else
strFinal = strFinal + strTexto(3) + IIf(Val(strGrupo(3)) <> 1, IIf(Val(strGrupo(1) + strGrupo(2) + strGrupo(3)) = 1, "pesos ", "pesos "), "real ")
End If
strFinal = strFinal + IIf(Val(strGrupo(4)) <> 0, "con " + strTexto(4) + IIf(Val(strGrupo(4)) = 1, "centavo", "centavos"), "")
End If
If Left(strFinal, 1) = "u" Then
Extenso = "" & Mid$(strFinal, 1)
Else
Extenso = UCase(Mid$(strFinal, 1, 1)) & Mid$(strFinal, 2)
End If

End Function

1 Respuesta

Respuesta
1

Martin: Al final del bucle For....., e inmediatamente antes del Next tienes ésto

If intTamanho = 1 Then
strTexto(intContador) = strTexto(intContador) + strUnid(Right(strParte, 1))
End If

Sustituyelo por ésto otro y haz las pruebas:

If IntTamanho = 1 Then
   If Val(StrParte) = 1 Then
         StrTexto(IntContador) = "Un "
   Else
        StrTexto(intContador) = strTexto(intContador) + strUnid(Right(strParte, 1))
   End If
End If

Un saludo >> Jacinto

Hola Jacinto gracias a tu respuesta el código funciona perfecto. Ahora tengo otro problema.... si quiero pasar el numero 1500000,00 me lo transforma en Un millones quinientos Mil pesos. También tengo problemas con la palabra "Mil" que se usa ya que si en este caso usa la palabra que esta en mayúscula y solo necesito que la primer letra de todas las palabras quede con Mayúscula

Martin: Ese ejemplo que tienes está muy bien, pero cualquier modificación requiere un análisis, o al menos para mi, y la verdad es que me cuesta de acuerdo a su construcción, además de que mi tiempo disponible es muy escaso.

Aunque en la red hay varios, uno que resulta muy intuitivo, si quieres personalizarlo (aunque no veo que se necesite), es uno de Neckkito (Un saludo si lo lees), que está en su Web.

http://neckkito.xyz/nck/index.php/ejemplos/18-codigo/161-numeros-a-letras 

Como verás la moneda es un parámetro Opcional. Un saludo >> Jacinto

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas