Por favor ayuda para modificar este codigo

09/12/2004 - 19:14 por iggv | Informe spam
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

#1 Lisandro
09/12/2004 - 20:00 | Informe spam
Hola iggv!
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.
...Una posible 'solucion' es:Estando en V°B
utiliza 'Control+F' te sale la pantalla
Buscar 'colocas' "Pesos" Luego en Remplazar con: colocas
Euros Luego le das Clip en remplazar todo, 'Posterior
haces lo mismo con Dolares'
Saludos
Lisandro


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


.

Preguntas similares