como puedo comvertir un cualquier numero a letras de 6 cifras

gared
13 de Abril del 2004
la verdad necesito la ayuda de unos expertos como lo soy y les agradeceria mucho si me respondieran lo mas breve posible gared

Meifer
13 de Abril del 2004
Esta es una funcion colocalo en un modulo para q te sirva para todos los formularios.

Public Function NumLetras(ByVal Numero As Double, ByVal Estilo As Integer, Optional bValor As Boolean = False) As String
Dim NumTmp As String, c01 As Integer, c02 As Integer, pos As Integer, dig As Integer
Dim cen As Integer, dec As Integer, uni As Integer, letra1 As String, letra2 As String
Dim letra3 As String, Leyenda As String, Leyenda1 As String, TFNumero As String

If Numero < 0 Then Numero = Abs(Numero)

NumTmp = Format(Numero, "000000000000000.00") 'Le da un formato fijo
c01 = 1
pos = 1
TFNumero = ""
'Para extraer tres digitos cada vez
Do While c01 <= 5
c02 = 1
Do While c02 <= 3
'Extrae un digito cada vez de izquierda a derecha
dig = Val(Mid(NumTmp, pos, 1))
Select Case c02
Case 1: cen = dig
Case 2: dec = dig
Case 3: uni = dig
End Select
c02 = c02 + 1
pos = pos + 1
Loop
letra3 = Centena(uni, dec, cen)
letra2 = Decena(uni, dec)
letra1 = Unidad(uni, dec)

Select Case c01
Case 1
If cen + dec + uni = 1 Then
Leyenda = "Billon "
ElseIf cen + dec + uni > 1 Then
Leyenda = "Billones "
End If
Case 2
If cen + dec + uni >= 1 And Val(Mid(NumTmp, 7, 3)) = 0 Then
Leyenda = "Mil Millones "
ElseIf cen + dec + uni >= 1 Then
Leyenda = "Mil "
End If
Case 3
If cen + dec = 0 And uni = 1 Then
Leyenda = "Millon "
ElseIf cen > 0 Or dec > 0 Or uni > 1 Then
Leyenda = "Millones "
End If
Case 4
If cen + dec + uni >= 1 Then
Leyenda = "Mil "
End If
Case 5
If cen + dec + uni >= 1 Then
Leyenda = ""
End If
End Select

c01 = c01 + 1
TFNumero = TFNumero + letra3 + letra2 + letra1 + Leyenda

Leyenda = ""
letra1 = ""
letra2 = ""
letra3 = ""
Loop

If Val(NumTmp) = 0 Or Val(NumTmp) < 1 Then
Leyenda1 = "Cero Bolivares "
ElseIf Val(NumTmp) = 1 Or Val(NumTmp) < 2 Then
Leyenda1 = "Bolivar "
ElseIf Val(Mid(NumTmp, 4, 12)) = 0 Or Val(Mid(NumTmp, 10, 6)) = 0 Then
Leyenda1 = "de Bolivares "
Else
Leyenda1 = "Bolivares "
End If

TFNumero = TFNumero & Leyenda1 & " con "
Select Case Estilo
Case 1: TFNumero = StrConv(TFNumero, vbUpperCase)
Case 2: TFNumero = StrConv(TFNumero, vbLowerCase)
Case Else: TFNumero = StrConv(TFNumero, vbProperCase)
End Select

TFNumero = TFNumero & Mid(NumTmp, 17) & "/100 "
If bValor Then TFNumero = TFNumero & "(Bs. " & FormatNumber(Numero, 2) & ")"
NumLetras = TFNumero

End Function

'//Centena de la function numletra
Private Function Centena(ByVal uni As Integer, ByVal dec As Integer, ByVal cen As Integer) As String
Dim vCentena As Variant

vCentena = Array("cien ", "ciento ", "doscientos ", "trescientos ", "cuatrocientos ", "quinientos ", "seiscientos ", "setecientos ", "ochocientos ", "novecientos ")
Select Case cen
Case 1: If dec + uni = 0 Then Centena = vCentena(0) Else Centena = vCentena(1)
Case 2, 3, 4, 5, 6, 7, 8, 9: Centena = vCentena(cen)
Case Else: Centena = ""
End Select
End Function


'//Decena de la function numletra
Private Function Decena(ByVal uni As Integer, ByVal dec As Integer) As String
Dim vNivel1 As Variant, vNivel2 As Variant

vNivel1 = Array("diez ", "once ", "doce ", "trece ", "catorce ", "quince ", "dieci")
vNivel2 = Array("", "", "", "treinta ", "cuarenta ", "cincuenta ", "sesenta ", "setenta ", "ochenta ", "noventa ")
Select Case dec
Case 1: If uni <= 5 Then Decena = vNivel1(uni) Else Decena = vNivel1(6)
Case 2: If uni = 0 Then Decena = "veinte " Else Decena = "veinti"
Case 3, 4, 5, 6, 7, 8, 9: Decena = vNivel2(dec)
Case Else: Decena = ""
End Select

If uni > 0 And dec > 2 Then Decena = Decena + "y "
End Function


'//Unidad de la function numletra
Public Function Unidad(ByVal uni As Integer, ByVal dec As Integer) As String
Dim vUnidad As Variant
vUnidad = Array("", "un ", "dos ", "tres ", "cuatro ", "cinco ", "seis ", "siete ", "ocho ", "nueve ")
If dec <> 1 Then
Select Case uni: Case 1, 2, 3, 4, 5: Unidad = vUnidad(uni): End Select
End If
Select Case uni: Case 6, 7, 8, 9: Unidad = vUnidad(uni): End Select
End Function





De esta forma pasas los parametros de la funcion

If Me.txtmontototal <> "" Then
Me.txtmontototal.Text = Format(Me.txtmontototal.Text, "###,###,###,##0.00")
Me.txtmontotalletra = NumLetras(Me.txtmontototal, 1)
End If

p/d Espero q te sirva