martes, 8 de septiembre de 2015

funcion nombre de mes

Option Explicit
 'Main Function
 Function NOMBRE_MES(ByVal MyNumber)
 Dim mes


 ' String representation of amount.
 MyNumber = Trim(Str(MyNumber))


 Select Case MyNumber
 Case "1"
 mes = "ENERO"
 Case "2"
 mes = "FEBRERO"
 Case "3"
 mes = "MARZO"
 Case "4"
 mes = "ABRIL"
 Case "5"
 mes = "MAYO"
 Case "6"
 mes = "JUNIO"
 Case "7"
 mes = "JULIO"
 Case "8"
 mes = "AGOSTO"
 Case "9"
 mes = "SEPTIEMBRE"
 Case "10"
 mes = "OCTUBRE"
 Case "11"
 mes = "NOVIEMBRE"
 Case "12"
 mes = "DICIEMBRE"

 Case Else
 mes = " "
 End Select
 NOMBRE_MES = mes

 End Function

miércoles, 15 de octubre de 2014

Función Spellnumber

Option Explicit
 'Main Function
 Function SpellNumber(ByVal MyNumber)
 Dim Dollars, Cents, Centavos, Temp, X
 Dim DecimalPlace, count, mn
 ReDim place(9) As String
 place(2) = " Mil "
 place(3) = " Millones "
 place(4) = " Billones "
 place(5) = " Trillones "
 mn = "/100 M.N."
 ' String representation of amount.
 MyNumber = Trim(Str(MyNumber))
 ' Position of decimal place 0 if none.
 DecimalPlace = InStr(MyNumber, ".")
 ' Convert cents and set MyNumber to dollar amount.
 If DecimalPlace > 0 Then
 Centavos = Left(Mid(MyNumber, DecimalPlace + 1) & _
 "00", 2)
 If Mid(Centavos, 1, 1) = "0" Then
 Cents = Getdecimal(Left(Mid(MyNumber, DecimalPlace + 1) & _
 "00", 2))
 Else
 If Len(Centavos) = 1 Then
 Cents = GetDigit(Left(Mid(MyNumber, DecimalPlace + 1) & _
 "00", 1))
 Else
 Cents = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & _
 "00", 2))
 End If
 End If

MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
 Else
 mn = "00/100 M.N."
 End If
 count = 1
 Do While MyNumber <> ""
 Temp = GetHundreds(Right(MyNumber, 3))
 If GetHundreds(Right(MyNumber, 3)) = "Uno " And count >= 2 Then
 Temp = "Un "
 place(3) = " Millón "
 place(4) = " Billón "
 place(5) = " Trillón "
 End If
 If Temp <> "" Then Dollars = Temp & place(count) & Dollars
 If Len(MyNumber) > 3 Then
 MyNumber = Left(MyNumber, Len(MyNumber) - 3)
 Else
 MyNumber = ""
 End If
 count = count + 1
 Loop
 Select Case Dollars
 Case ""
 Dollars = ""
 Case "Uno"
 Dollars = "Un"
 Case Else
 Dollars = Dollars & " "
 End Select
 Select Case Cents
 Case ""
 Cents = " "
 Case "Uno"
 Cents = " punto Uno"
 Case Else
 Cents = " punto " & Cents & ""
 End Select
 SpellNumber = Dollars & "Pesos " & Centavos & mn

 End Function


' Converts a number from 100-999 into text
 Function GetHundreds(ByVal MyNumber)
 Dim Result As String
 If Val(MyNumber) = 0 Then Exit Function
 MyNumber = Right("000" & MyNumber, 3)
 ' Convert the hundreds place.
 If Mid(MyNumber, 1, 1) > "0" Then
 Select Case Mid(MyNumber, 1, 1)
 Case "1"
 If Mid(MyNumber, 2, 2) > "00" Then
 Result = " Ciento "
 Else
 Result = " Cien "
 End If
 Case "2": Result = " Doscientos "
 Case "3": Result = " Trescientos "
 Case "4": Result = " Cuatrocientos "
 Case "5": Result = " Quinientos "
 Case "6": Result = " Seiscientos "
 Case "7": Result = " Setecientos "
 Case "8": Result = " Ochocientos "
 Case "9": Result = " Novecientos "
 End Select
 Else
 If Mid(MyNumber, 1, 1) > "1" Then
 Result = GetDigit(Mid(MyNumber, 1, 1)) & "Cien "
 End If
 End If
 ' Convert the tens and ones place.
 If Mid(MyNumber, 2, 1) <> "0" Then
 Result = Result & GetTens(Mid(MyNumber, 2))
 Else
 Result = Result & GetDigit(Mid(MyNumber, 3))
 End If
 GetHundreds = Result
 End Function

 ' Converts a number from 10 to 99 into text.
 Function GetTens(TensText)
 Dim Result As String
 Result = "" ' Null out the temporary function value.
 If Val(Left(TensText, 1)) = 1 Then ' If value between 10-19...
 Select Case Val(TensText)
 Case 10: Result = "Diez"
 Case 11: Result = "Once"
 Case 12: Result = "Doce"
 Case 13: Result = "Trece"
 Case 14: Result = "Catorce"
 Case 15: Result = "Quince"
 Case 16: Result = "Dieciseis"
 Case 17: Result = "Diecisiete"
 Case 18: Result = "Dieciocho"
 Case 19: Result = "Diecinueve"
 Case Else
 End Select
 Else ' If value between 20-99...
 If Val(Right(TensText, 1)) = 0 Then
 Select Case Val(Left(TensText, 1))
 Case 2: Result = "Veinte "
 Case 3: Result = "Treinta "
 Case 4: Result = "Cuarenta "
 Case 5: Result = "Cincuenta "
 Case 6: Result = "Sesenta "
 Case 7: Result = "Setenta "
 Case 8: Result = "Ochenta "
 Case 9: Result = "Noventa "
 Case Else
 End Select
 Else
 Select Case Val(Left(TensText, 1))
 Case 2: Result = "Veinti"
 Case 3: Result = "Treinta y "
 Case 4: Result = "Cuarenta y "
 Case 5: Result = "Cincuenta y "
 Case 6: Result = "Sesenta y "
 Case 7: Result = "Setenta y "
 Case 8: Result = "Ochenta y "
 Case 9: Result = "Noventa y "
 Case Else
 End Select
 End If
 Result = Result & GetDigit _
 (Right(TensText, 1)) ' Retrieve ones place.
 End If
 GetTens = Result
 End Function

 ' Converts a number from 1 to 9 into text.
 Function GetDigit(Digit)
 Select Case Val(Digit)
 Case 1: GetDigit = "Un"
 Case 2: GetDigit = "Dos"
 Case 3: GetDigit = "Tres"
 Case 4: GetDigit = "Cuatro"
 Case 5: GetDigit = "Cinco"
 Case 6: GetDigit = "Seis"
 Case 7: GetDigit = "Siete"
 Case 8: GetDigit = "Ocho"
 Case 9: GetDigit = "Nueve"
 Case Else: GetDigit = ""
 End Select
 End Function

' Converts a number from .01 to .09 into text.
 Function Getdecimal(Digit)
 Select Case Digit
 Case "00": Getdecimal = "Cero Cero "
 Case "01": Getdecimal = "Cero Uno "
 Case "02": Getdecimal = "Cero Dos"
 Case "03": Getdecimal = "Cero Tres"
 Case "04": Getdecimal = "Cero Cuatro"
 Case "05": Getdecimal = "Cero Cinco"
 Case "06": Getdecimal = "Cero Seis"
 Case "07": Getdecimal = "Cero Siete"
 Case "08": Getdecimal = "Cero Ocho"
 Case "09": Getdecimal = "Cero Nueve"
 Case Else: Getdecimal = ""
 End Select
 End Function