Autor
|
Tema: funcion para convertir un inporte en letra en visual basic 6.0 (Leído 5,592 veces)
|
almita
Desconectado
Mensajes: 212
|
alguien save de un afuncion en vb para poder convertir un importe(numeroi a letra ejemplo $120 = ciento veinte pesos les agradeceria mucho su orientacion gracias por aqui nado
|
|
|
En línea
|
|
|
|
|
|
almita
Desconectado
Mensajes: 212
|
osea que vb no tiene una funcion para realizar esto del cambio de numero a letra
|
|
|
En línea
|
|
|
|
Hans el Topo
Desconectado
Mensajes: 1.754
"Estoy cansado de no hacer nada"
|
osea que vb no tiene una funcion para realizar esto del cambio de numero a letra
alguien si buscas por internete encuentras algun ocx de algun zumbao k se le ocurrio hacerlo en varios idiomas y tal...xd
|
|
|
En línea
|
|
|
|
erick185
Desconectado
Mensajes: 57
|
Hola Yo lo hago de esta forma, necesitas "2 text (txt, tletras) y 3 botones (cmd, command1, command2)": Option Explicit Private sw As cls_NumSpanishWord
Private Sub cmd_Click() Set sw = New cls_NumSpanishWord tletras = sw.ConvertCurrencyToSpanish(txt, "Quetzales") Set sw = Nothing End Sub
Private Sub Command1_Click() End End Sub
Private Sub Command2_Click() txt.Text = "" tletras.Text = "" txt.SetFocus End Sub Para el modulo: DefLng A-Z Option Explicit
Public Const Void As String = "" Public Const Dot As String = "."
'//String utility Public Sub ReplaceStringFrom(s As String, OldWrd As String, NewWrd As String, ptr) s = Left$(s, ptr - 1) + NewWrd + Mid$(s, Len(OldWrd) + ptr) End Sub
'//String utility Public Sub ReplaceAll(s As String, OldWrd As String, NewWrd As String) Dim ptr Do ptr = InStr(s, OldWrd) If ptr Then s = Left$(s, ptr - 1) + NewWrd + Mid$(s, Len(OldWrd) + ptr) End If Loop Until ptr = 0 End Sub
'//String utility Public Function Singular(s As String) As String If Len(s) >= 2 Then If Right$(s, 1) = "s" Then If Right$(s, 2) = "es" Then Singular = Left$(s, Len(s) - 2) Else Singular = Left$(s, Len(s) - 1) End If Else Singular = s End If End If End Function Para el modulo clase: DefLng A-Z Option Explicit
'//PROPERTY: m_FeminineGenerous Private m_FeminineGenerous As Boolean
Public Function ConvertCurrencyToSpanish( _ ByVal Number As Variant, _ ByVal CurrentMoney As Variant, _ Optional FeminineGenerous As Variant = False _ ) As String Dim s As String Dim DecimalPlace As Long Dim IntPart As String Dim Cents As String
m_FeminineGenerous = FeminineGenerous s = Format(Val(Number), "0.00") DecimalPlace = InStr(s, Dot) If DecimalPlace Then IntPart = Left$(s, DecimalPlace - 1) Cents = Left$(Mid$(s, DecimalPlace + 1, 2), 2) Else IntPart = s Cents = Void End If
If IntPart = "0" Or IntPart = Void Then s = "Cero " ElseIf Len(IntPart) > 7 Then s = IntNumToSpanish(Val(Left$(IntPart, Len(IntPart) - 6))) + _ "Millones " + IntNumToSpanish(Val(Right$(IntPart, 6))) Else s = IntNumToSpanish(Val(IntPart)) End If
If Right$(s, 9) = "Millones " Or Right$(s, 7) = "Millón " Then s = s + "de " End If Select Case s Case "Un ", "Una " s = s & Singular(CStr(CurrentMoney)) Case Else s = s & CurrentMoney End Select
If Val(Cents) Then Cents = " con " + IntNumToSpanish(Val(Cents)) + "Centavos" Else Cents = " con Cero Centavos" End If
ConvertCurrencyToSpanish = s + Cents End Function
Public Function IntNumToSpanish(numero As Long) As String Dim ptr Dim n Dim i Dim s As String Dim rtn As String Dim tem As String s = CStr(numero) n = Len(s)
tem = Void i = n Do Until i = 0 tem = EvalPart(Val(Mid$(s, n - i + 1, 1) + String$(i - 1, "0"))) If Not tem = "Cero" Then rtn = rtn + tem + " " End If i = i - 1 Loop '//Filters GoSub filterThousands GoSub filterHundreds GoSub filterMisc GoSub filterOne GoSub addAnd IntNumToSpanish$ = rtn Exit Function
filterThousands: ReplaceAll rtn, " Mil Mil", " Un Mil" Do ptr = InStr(rtn, "Mil ") If ptr Then If InStr(ptr + 1, rtn, "Mil ") Then ReplaceStringFrom rtn, "Mil ", "", ptr Else: Exit Do End If Else: Exit Do End If Loop Return
filterHundreds: ptr = 0 Do ptr = InStr(ptr + 1, rtn, "Cien ") If ptr Then tem = Left$(Mid$(rtn, ptr + 5), 1) If tem = "M" Or tem = Void Then Else ReplaceStringFrom rtn, "Cien", "Ciento", ptr End If End If Loop Until ptr = 0 Return
filterMisc: ReplaceAll rtn, "Diez Un", "Once" ReplaceAll rtn, "Diez Dos", "Doce" ReplaceAll rtn, "Diez Tres", "Trece" ReplaceAll rtn, "Diez Cuatro", "Catorce" ReplaceAll rtn, "Diez Cinco", "Quince" ReplaceAll rtn, "Diez Seis", "Dieciseis" ReplaceAll rtn, "Diez Siete", "Diecisiete" ReplaceAll rtn, "Diez Ocho", "Dieciocho" ReplaceAll rtn, "Diez Nueve", "Diecinueve" ReplaceAll rtn, "Veinte Un", "Veintiun" ReplaceAll rtn, "Veinte Dos", "Veintidos" ReplaceAll rtn, "Veinte Tres", "Veintitres" ReplaceAll rtn, "Veinte Cuatro", "Veinticuatro" ReplaceAll rtn, "Veinte Cinco", "Veinticinco" ReplaceAll rtn, "Veinte Seis", "Veintiseís" ReplaceAll rtn, "Veinte Siete", "Veintisiete" ReplaceAll rtn, "Veinte Ocho", "Veintiocho" ReplaceAll rtn, "Veinte Nueve", "Veintinueve" Return
filterOne: If Left$(rtn, 1) = "M" Then rtn = "Un " + rtn End If '//Un Mil... If Left$(rtn, 6) = "Un Mil" Then rtn = Mid$(rtn, 4) End If Return
addAnd: For i = 65 To 88 If Not i = 77 Then ReplaceAll rtn, "a " + Chr$(i), "* y " + Chr$(i) End If Next ReplaceAll rtn, "*", "a" Return
End Function
Private Function EvalPart(x As Long) As String Dim rtn As String, s As String, i Do GoSub SinglePart If s = Void Then i = i + 1 x = x / 1000 If x = 0 Then i = 0 Else Exit Do End If Loop Until i = 0 rtn = s GoSub EngPart EvalPart = rtn + s Exit Function
SinglePart: Select Case x Case 0: s = "Cero" Case 1: s = "Un" Case 2: s = "Dos" Case 3: s = "Tres" Case 4: s = "Cuatro" Case 5: s = "Cinco" Case 6: s = "Seis" Case 7: s = "Siete" Case 8: s = "Ocho" Case 9: s = "Nueve" Case 10: s = "Diez" Case 20: s = "Veinte" Case 30: s = "Treinta" Case 40: s = "Cuarenta" Case 50: s = "Cincuenta" Case 60: s = "Sesenta" Case 70: s = "Setenta" Case 80: s = "Ochenta" Case 90: s = "Noventa" Case 100: s = "Cien" Case 200: s = "Doscientos" Case 300: s = "Trescientos" Case 400: s = "Cuatrocientos" Case 500: s = "Quinientos" Case 600: s = "Seiscientos" Case 700: s = "Setecientos" Case 800: s = "Ochocientos" Case 900: s = "Novecientos" Case 1000: s = "Mil" Case 1000000: s = "Millón" End Select If m_FeminineGenerous Then ReplaceAll s, "tos", "tas" If s = "Un" Then s = "Una" End If Return
EngPart: '//E+00... Select Case i Case 0: s = Void Case 1: s = " Mil" Case 2: s = " Millones" Case 3: s = " Billones" End Select Return
End Function Salu2
|
|
|
En línea
|
|
|
|
almita
Desconectado
Mensajes: 212
|
ya la tengo chavos muchas gracias espero que el codigo que me dieron le sirva a alguien mas
|
|
|
En línea
|
|
|
|
|
|