Ayuda en Argumentos de funcion

21/11/2006 - 20:45 por IGGV | Informe spam
Hola a todos, utilizo la funcion que transcribo mas abajo para
transcribir en una cifra monetaria en letras ($ 1 = Pesos Uno). Cuando
llamo por el Asistente de funciones a esta funcion me muestra dos
casilleros, en el primero elijo la celda donde esta el monto en numeros
y en el segundo casillero elijo el tipo de moneda que debe informar 0 Dolares, 1 = Pesos, 2 = Euros. La cuestion es que al elegir los
casilleros la ventana del asistente marca que no hay ayuda disponible
para los argumantos de la funcion, y a mi me gustaria poder informarles
a los usuarios las distintas posiblidades de monedas.
Se puede hacer?

Desde ya muchas gracias

iggv


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
If nTipoMoneda = 2 Then
Tercias = "EUROS " & sCadenaFinal & " con " &
sDecimal & "00/100"
Else
Tercias = "DOLARES " & sCadenaFinal & " con " &
sDecimal & "00/100"
End If
End If
Else
If nTipoMoneda = 1 Then
Tercias = "PESOS " & sCadenaFinal & " con " &
sDecimal & "/100"
Else
If nTipoMoneda = 2 Then
Tercias = "EUROS " & sCadenaFinal & " con " &
sDecimal & "00/100"
Else
Tercias = "DOLARES " & sCadenaFinal & " con " &
sDecimal & "/100"
End If
End If
End If
Else
If sCadenaFinal = " UN " Then
If nTipoMoneda = 1 Then
Tercias = "PESOS " & sCadenaFinal & " con " &
sDecimal & "00/100"
Else
If nTipoMoneda = 2 Then
Tercias = "EUROS " & sCadenaFinal & " con " &
sDecimal & "00/100"
Else
Tercias = "DOLARES " & sCadenaFinal & " con " &
sDecimal & "00/100"
End If
End If
Else
If nTipoMoneda = 1 Then
Tercias = "PESOS " & sCadenaFinal & " con " &
sDecimal & "00/100"
Else
If nTipoMoneda = 2 Then
Tercias = "EUROS " & sCadenaFinal & " con " &
sDecimal & "00/100"
Else
Tercias = "DOLARES " & sCadenaFinal & " con " &
sDecimal & "00/100"
End If
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 Héctor Miguel
22/11/2006 - 06:33 | Informe spam
hola, Ignacio ?

... utilizo la funcion... abajo para transcribir en una cifra monetaria en letras
... por el Asistente de funciones a esta funcion me muestra dos casilleros
en el primero elijo la celda donde esta el monto en numeros
y en el segundo casillero elijo el tipo de moneda que debe informar 0 = Dolares, 1 = Pesos, 2 = Euros.
... al elegir los casilleros la ventana del asistente marca que no hay ayuda disponible para los argumantos de la funcion
y a mi me gustaria poder informarles a los usuarios las distintas posiblidades de monedas. Se puede hacer?



[punto aparte]: me parece demasiado 'larga' la funcion que utilizas, revisa: -> http://tinyurl.com/newym

para agregar 'instrucciones' a los argumentos de funciones personalizadas, tienes -al menos- dos opciones:
a) usar un complemento de terceros: 'FunCustomize' de Laurent Longre
b) aprovechas las opciones 'nativas' de excel-vba para asignar otros argumentos a las funciones personalizadas
-> encuentras comentarios de ambos procedimientos en las siguientes conversaciones: -> http://tinyurl.com/yxpewx

si cualquier duda [o informacion adicional]... comentas ?
saludos,
hector.

Preguntas similares