Buenos días estimado, aun sigo sin poder resolver el problema, te muestro lo que realmente requiero:
Option Compare Database
Function letra(Numero)
Dim Texto
Dim Millones
Dim Miles
Dim Cientos
Dim Decimales
Dim Cadena
Dim CadMillones
Dim CadMiles
Dim CadCientos
Dim caddecimales
Texto = Round(Numero, 2)
Texto = FormatNumber(Texto, 2)
Texto = Right(Space(14) & Texto, 14)
Millones = Mid(Texto, 1, 3)
Miles = Mid(Texto, 5, 3)
Cientos = Mid(Texto, 9, 3)
Decimales = Mid(Texto, 13, 2)
CadMillones = ConvierteCifra(Millones, False)
CadMiles = ConvierteCifra(Miles, False)
CadCientos = ConvierteCifra(Cientos, True)
caddecimales = ConvierteDecimal(Decimales)
If Trim(CadMillones) > "" Then
If Trim(CadMillones) = "Un" Then
Cadena = CadMillones & " Millón"
Else
Cadena = CadMillones & " Millones"
End If
End If
If Trim(CadMiles) > "" Then
If Trim(CadMiles) = "Un" Then
CadMiles = ""
Cadena = Cadena & "" & CadMiles & "Mil"
CadMiles = "Un"
Else
Cadena = Cadena & " " & CadMiles & " Mil"
End If
End If
If Trim(CadMiles) > "001" Then
CadMiles = "Mil"
End If
If Decimales = "00" Then
If Trim(CadMillones & CadMiles & CadCientos & caddecimales) = "Un" Then
Cadena = Cadena & "Uno "
Else
If Miles & Cientos = "000000" Then
Cadena = Cadena & " " & Trim(CadCientos)
Else
Cadena = Cadena & " " & Trim(CadCientos)
End If
letra = Trim(Cadena)
End If
Else
If Trim(CadMillones & CadMiles & CadCientos & caddecimales) = "Un" Then
Cadena = Cadena & "Uno " & "Con " & Trim(caddecimales)
Else
If Millones & Miles & Cientos & Decimales = "000000" Then
Cadena = Cadena & " " & Trim(CadCientos) & " " & "Con " & Trim(Decimales) & "/100 Soles"
'Cadena = Cadena & " " & Trim(CadCientos) & " PESOS " & Trim(Decimales) & "con/100 M.N."
Else
Cadena = Cadena & " " & Trim(CadCientos) & " " & "Con " & Trim(Decimales) & "/100 Soles"
'Cadena = Cadena & " " & Trim(CadCientos) & " PESOS " & Trim(Decimales) & "/100 M.N."
End If
letra = Trim(Cadena)
End If
End If
End Function
Function ConvierteCifra(Texto, IsCientos As Boolean)
Dim Centena
Dim Decena
Dim Unidad
Dim txtCentena
Dim txtDecena
Dim txtUnidad
Centena = Mid(Texto, 1, 1)
Decena = Mid(Texto, 2, 1)
Unidad = Mid(Texto, 3, 1)
Select Case Centena
Case "1"
txtCentena = "Cien"
If Decena & Unidad <> "00" Then
txtCentena = "Ciento"
End If
Case "2"
txtCentena = "Doscientos"
Case "3"
txtCentena = "Trescientos"
Case "4"
txtCentena = "Cuatrocientos"
Case "5"
txtCentena = "Quinientos"
Case "6"
txtCentena = "Seiscientos"
Case "7"
txtCentena = "Setecientos"
Case "8"
txtCentena = "Ochocientos"
Case "9"
txtCentena = "Novecientos"
End Select
Select Case Decena
Case "1"
txtDecena = "Diez"
Select Case Unidad
Case "1"
txtDecena = "Once"
Case "2"
txtDecena = "Doce"
Case "3"
txtDecena = "Trece"
Case "4"
txtDecena = "Catorce"
Case "5"
txtDecena = "Quince"
Case "6"
txtDecena = "Dieciseis"
Case "7"
txtDecena = "Diecisiete"
Case "8"
txtDecena = "Dieciocho"
Case "9"
txtDecena = "Diecinueve"
End Select
Case "2"
txtDecena = "Veinte"
If Unidad <> "0" Then
txtDecena = "Veinti"
End If
Case "3"
txtDecena = "Treinta"
If Unidad <> "0" Then
txtDecena = "Treinta y "
End If
Case "4"
txtDecena = "Cuarenta"
If Unidad <> "0" Then
txtDecena = "Cuarenta y "
End If
Case "5"
txtDecena = "Cincuenta"
If Unidad <> "0" Then
txtDecena = "Cincuenta y "
End If
Case "6"
txtDecena = "Sesenta"
If Unidad <> "0" Then
txtDecena = "Sesenta y "
End If
Case "7"
txtDecena = "Setenta"
If Unidad <> "0" Then
txtDecena = "Setenta y "
End If
Case "8"
txtDecena = "Ochenta"
If Unidad <> "0" Then
txtDecena = "Ochenta y "
End If
Case "9"
txtDecena = "Noventa"
If Unidad <> "0" Then
txtDecena = "Noventa y "
End If
End Select
If Decena <> "1" Then
Select Case Unidad
Case "1"
If IsCientos = False Then
txtUnidad = "Un"
Else
txtUnidad = "Uno"
End If
Case "2"
txtUnidad = "Dos"
Case "3"
txtUnidad = "Tres"
Case "4"
txtUnidad = "Cuatro"
Case "5"
txtUnidad = "Cinco"
Case "6"
txtUnidad = "Seis"
Case "7"
txtUnidad = "Siete"
Case "8"
txtUnidad = "Ocho"
Case "9"
txtUnidad = "Nueve"
End Select
End If
ConvierteCifra = txtCentena & " " & txtDecena & txtUnidad
End Function
Function ConvierteDecimal(Texto)
Dim Decenadecimal
Dim Unidaddecimal
Dim txtDecenadecimal
Dim txtUnidaddecimal
Decenadecimal = Mid(Texto, 1, 1)
Unidaddecimal = Mid(Texto, 2, 1)
Select Case Decenadecimal
Case "1"
txtDecenadecimal = "Diez"
Select Case Unidaddecimal
Case "1"
txtDecenadecimal = "Once"
Case "2"
txtDecenadecimal = "Doce"
Case "3"
txtDecenadecimal = "Trece"
Case "4"
txtDecenadecimal = "Catorce"
Case "5"
txtDecenadecimal = "Quince"
Case "6"
txtDecenadecimal = "Dieciseis"
Case "7"
txtDecenadecimal = "Diecisiete"
Case "8"
txtDecenadecimal = "Dieciocho"
Case "9"
txtDecenadecimal = "Diecinueve"
End Select
Case "2"
txtDecenadecimal = "Veinte"
If Unidaddecimal <> "0" Then
txtDecenadecimal = "Veinti"
End If
Case "3"
txtDecenadecimal = "Treinta"
If Unidaddecimal <> "0" Then
txtDecenadecimal = "Treinta y "
End If
Case "4"
txtDecenadecimal = "Cuarenta"
If Unidaddecimal <> "0" Then
txtDecenadecimal = "Cuarenta y "
End If
Case "5"
txtDecenadecimal = "Cincuenta"
If Unidaddecimal <> "0" Then
txtDecenadecimal = "Cincuenta y "
End If
Case "6"
txtDecenadecimal = "Sesenta"
If Unidaddecimal <> "0" Then
txtDecenadecimal = "Sesenta y "
End If
Case "7"
txtDecenadecimal = "Setenta"
If Unidaddecimal <> "0" Then
txtDecenadecimal = "Setenta y "
End If
Case "8"
txtDecenadecimal = "Ochenta"
If Unidaddecimal <> "0" Then
txtDecenadecimal = "Ochenta y "
End If
Case "9"
txtDecenadecimal = "Noventa"
If Unidaddecimal <> "0" Then
txtDecenadecimal = "Noventa y "
End If
End Select
If Decenadecimal <> "1" Then
Select Case Unidaddecimal
Case "1"
txtUnidaddecimal = "Uno"
Case "2"
txtUnidaddecimal = "Dos"
Case "3"
txtUnidaddecimal = "Tres"
Case "4"
txtUnidaddecimal = "Cuatro"
Case "5"
txtUnidaddecimal = "Cinco"
Case "6"
txtUnidaddecimal = "Seis"
Case "7"
txtUnidaddecimal = "Siete"
Case "8"
txtUnidaddecimal = "Ocho"
Case "9"
txtUnidaddecimal = "Nueve"
End Select
End If
If Decenadecimal = 0 And Unidaddecimal = 0 Then
ConvierteDecimal = "00/100"
Else
ConvierteDecimal = txtDecenadecimal & txtUnidaddecimal
End If
End Function