Tengo el siguiente codigo que me paso hace mucho tiempo Sergio Cerda para
pasar una cifra de numero a letras agregandole el tipo de moneda adelante,
pero solo puedo optar por Pesos o Dolares.
Me gustaria poder agregarle la opcion de Euros.
Function Numero_A_Letra(rgNumero As Range, nTipoMoneda As Byte) As String
'If nTipoMoneda <> 1 And nTipoMoneda <> 2 Then
' Load frmTipoMoneda
' frmTipoMoneda.Show
'End If
Numero_A_Letra = Tercias(rgNumero, nTipoMoneda)
End Function
Private Function Tercias(nNumero As Range, nTipoMoneda As Byte) As String
Dim nLongitud, nI, nConjunto, nContador, nPunto As Integer
Dim sNumero, sDecimal, arrTercia(5), sLetraTercia, sCadenaFinal,
sNombreTercia As String
sNumero = Trim(Str(Int(nNumero.Value)))
nPunto = 0
For nI = 1 To Len(Trim(Str(nNumero.Value)))
If Mid(Trim(Str(nNumero.Value)), nI, 1) = "." Then
nPunto = nI
End If
Next nI
If nPunto > 0 Then
sDecimal = Mid(Trim(Str(nNumero.Value)), nPunto + 1, 2)
If Len(sDecimal) = 1 Then
sDecimal = sDecimal & "0"
End If
End If
nLongitud = Len(sNumero)
nConjunto = 0
' Divide por tercias
For nI = nLongitud To 1 Step -1
nContador = nContador + 1
If (((nContador - 1) / 3) - Int((nContador - 1) / 3)) = 0 Then
nConjunto = nConjunto + 1
End If
arrTercia(nConjunto) = Mid(sNumero, nI, 1) & arrTercia(nConjunto)
Next nI
sCadenaFinal = ""
While nConjunto > 0
sLetraTercia = ""
sLetraTercia = Convertir_Letra(Val(arrTercia(nConjunto)))
'
sNombreTercia = ""
If sLetraTercia <> "" Then
Select Case nConjunto
Case 1
sNombreTercia = ""
Case 2
sNombreTercia = " MIL"
Case 3
If arrTercia(nConjunto) = "1" Then
sNombreTercia = " MILLON"
Else
sNombreTercia = " MILLONES"
End If
Case 4
If arrTercia(nConjunto) = "1" Then
sNombreTercia = " BILLON"
Else
sNombreTercia = " BILLONES"
End If
Case 5
If arrTercia(nConjunto) = "1" Then
sNombreTercia = " TRILLON"
Else
sNombreTercia = " TRILLONES"
End If
End Select
End If
'
sCadenaFinal = sCadenaFinal & sLetraTercia & sNombreTercia
nConjunto = nConjunto - 1
Wend
If sCadenaFinal <> "" Then
If sDecimal <> "" Then
If sCadenaFinal = " UN " Then
If nTipoMoneda = 1 Then
Tercias = "PESOS " & sCadenaFinal & " con " & sDecimal &
"00/100"
Else
Tercias = "DOLARES " & sCadenaFinal & " con " & sDecimal
& "00/100"
End If
Else
If nTipoMoneda = 1 Then
Tercias = "PESOS " & sCadenaFinal & " con " & sDecimal &
"/100"
Else
Tercias = "DOLARES " & sCadenaFinal & " con " & sDecimal
& "/100"
End If
End If
Else
If sCadenaFinal = " UN " Then
If nTipoMoneda = 1 Then
Tercias = "PESOS " & sCadenaFinal & " con " & sDecimal &
"00/100"
Else
Tercias = "DOLARES " & sCadenaFinal & " con " & sDecimal
& "00/100"
End If
Else
If nTipoMoneda = 1 Then
Tercias = "PESOS " & sCadenaFinal & " con " & sDecimal &
"00/100"
Else
Tercias = "DOLARES " & sCadenaFinal & " con " & sDecimal
& "00/100"
End If
End If
End If
Else
Tercias = " - "
End If
End Function
Private Function Convertir_Letra(nNumero As Integer) As String
' Propósito : Convierte la parte entera de cantidad de números a letras
Dim sEntero, sNumeroActual, sLetra As String
Dim nLongitud, nI, nPosicion As Integer
Dim arrDigito(10) As String
' Extraemos la parte entera y decimal del número
sEntero = Trim(Str(Int(nNumero)))
If Len(sEntero) = 1 Then
sEntero = "00" & sEntero
Else
If Len(sEntero) = 2 Then
sEntero = "0" & sEntero
End If
End If
' Procedemos a convertir la parte entera
nI = 1
While nI <= 3
sNumeroActual = Mid(sEntero, nI, 1)
If nI = 1 Then
nPosicion = 3
Else
If nI = 2 Then
nPosicion = 2
Else
nPosicion = 1
End If
End If
' Si nPosicion = 1-Digitos, nPosicion = 2-Decimas, nPosicion 3-Centenas
If nPosicion = 1 Then
Select Case Val(sNumeroActual)
Case 1
sLetra = sLetra & " UN"
Case 2
sLetra = sLetra & " DOS"
Case 3
sLetra = sLetra & " TRES"
Case 4
sLetra = sLetra & " CUATRO"
Case 5
sLetra = sLetra & " CINCO"
Case 6
sLetra = sLetra & " SEIS"
Case 7
sLetra = sLetra & " SIETE"
Case 8
sLetra = sLetra & " OCHO"
Case 9
sLetra = sLetra & " NUEVE"
End Select
Else
If nPosicion = 2 Then
Select Case Val(sNumeroActual)
Case 1
Select Case Val(Mid(sEntero, 3, 1))
Case 0
sLetra = sLetra & " DIEZ"
Case 1
sLetra = sLetra & " ONCE"
Case 2
sLetra = sLetra & " DOCE"
Case 3
sLetra = sLetra & " TRECE"
Case 4
sLetra = sLetra & " CATORCE"
Case 5
sLetra = sLetra & " QUINCE"
Case 6
sLetra = sLetra & " DIECISEIS"
Case 7
sLetra = sLetra & " DIECISIETE"
Case 8
sLetra = sLetra & " DIECIOCHO"
Case 9
sLetra = sLetra & " DIECINUEVE"
End Select
If Val(Mid(sEntero, 3, 1)) > 0 Then
nI = nI + 1
End If
Case 2
Select Case Val(Mid(sEntero, 3, 1))
Case 1
sLetra = sLetra & " VEINTIUN"
Case 2
sLetra = sLetra & " VEINTIDOS"
Case 3
sLetra = sLetra & " VEINTITRES"
Case 4
sLetra = sLetra & " VEINTICUATRO"
Case 5
sLetra = sLetra & " VEINTICINCO"
Case 6
sLetra = sLetra & " VEINTISEIS"
Case 7
sLetra = sLetra & " VEINTISIETE"
Case 8
sLetra = sLetra & " VEINTIOCHO"
Case 9
sLetra = sLetra & " VEINTINUEVE"
Case 0
sLetra = sLetra & " VEINTE"
End Select
If Val(Mid(sEntero, 3, 1)) > 0 Then
nI = nI + 1
End If
Case 3
If Val(Mid(sEntero, 3, 1)) = 0 Then
sLetra = sLetra & " TREINTA"
Else
sLetra = sLetra & " TREINTA Y"
End If
Case 4
If Val(Mid(sEntero, 3, 1)) = 0 Then
sLetra = sLetra & " CUARENTA"
Else
sLetra = sLetra & " CUARENTA Y"
End If
Case 5
If Val(Mid(sEntero, 3, 1)) = 0 Then
sLetra = sLetra & " CINCUENTA"
Else
sLetra = sLetra & " CINCUENTA Y"
End If
Case 6
If Val(Mid(sEntero, 3, 1)) = 0 Then
sLetra = sLetra & " SESENTA"
Else
sLetra = sLetra & " SESENTA Y"
End If
Case 7
If Val(Mid(sEntero, 3, 1)) = 0 Then
sLetra = sLetra & " SETENTA"
Else
sLetra = sLetra & " SETENTA Y"
End If
Case 8
If Val(Mid(sEntero, 3, 1)) = 0 Then
sLetra = sLetra & " OCHENTA"
Else
sLetra = sLetra & " OCHENTA Y"
End If
Case 9
If Val(Mid(sEntero, 3, 1)) = 0 Then
sLetra = sLetra & " NOVENTA"
Else
sLetra = sLetra & " NOVENTA Y"
End If
End Select
Else
Select Case Val(sNumeroActual)
Case 1
If Mid(sEntero, 2, 2) = "00" Then
sLetra = sLetra & " CIEN"
Else
sLetra = sLetra & " CIENTO"
End If
Case 2
sLetra = sLetra & " DOSCIENTOS"
Case 3
sLetra = sLetra & " TRESCIENTOS"
Case 4
sLetra = sLetra & " CUATROCIENTOS"
Case 5
sLetra = sLetra & " QUINIENTOS"
Case 6
sLetra = sLetra & " SEISCIENTOS"
Case 7
sLetra = sLetra & " SETECIENTOS"
Case 8
sLetra = sLetra & " OCHOCIENTOS"
Case 9
sLetra = sLetra & " NOVECIENTOS"
End Select
End If ' nPosicion = 2
End If ' nPosicion = 1
nI = nI + 1
Wend
Convertir_Letra = sLetra
End Function
Leer las respuestas