Visual Basic - RE:Técnico Computación

Life is soft - evento anual de software empresarial
 
Vista:

RE:Técnico Computación

Publicado por Christian (675 intervenciones) el 06/06/2005 20:11:21
aqui hay una funcion de numeros a letras, a ver si te sirve o si no modificas.

Public Function fuNumerosLetras( _
ByVal dbNumero As Double)

Dim inAux As Integer
Dim inPos As Integer
Dim inTamEnt As Integer
Dim inTamNum As Integer
Dim inTamNumIni As Integer
Dim inDigCen As Integer
Dim inDigDec As Integer
Dim inDigUni As Integer

Dim stNum As String
Dim stSig As String
Dim stTex As String
Dim stParDec As String
Dim stParEnt As String

inPos = 1
stNum = CStr(dbNumero)
inTamNum = Len(stNum)

stTex = ""
stParDec = ""
stParEnt = stNum

Do While (inPos <= inTamNum)
stSig = Mid(stNum, inPos, 1)
If (stSig = "." Or stSig = ",") Then
stParDec = Right(stNum, inTamNum - inPos)
stParEnt = Mid(stNum, 1, inPos - 1)
Exit Do
End If

inPos = inPos + 1
Loop

inTamEnt = Len(stParEnt)
inAux = 1

Do While (inAux = 1)
inTamNumIni = Len(stParEnt)
inTamNum = Len(stParEnt)

Select Case inTamNum
Case 1 To 9
inAux = 1
Case Else
inAux = 0
End Select

inDigCen = 0
inDigDec = 0
inDigUni = 0

inTamNum = Len(stParEnt)
If (inTamNum = 9 Or inTamNum = 6 Or inTamNum = 3) Then
inDigCen = CInt(Mid(stParEnt, 1, 1))
stParEnt = Mid(stParEnt, 2, inTamNum - 1)
Select Case inDigCen
Case 1
Select Case Mid(stParEnt, 1, 2)
Case "00"
stTex = stTex + "CIEN "
Case Else
stTex = stTex + "CIENTO "
End Select
Case 2
stTex = stTex + "DOSCIENTOS "
Case 3
stTex = stTex + "TRESCIENTOS "
Case 4
stTex = stTex + "CUATROCIENTOS "
Case 5
stTex = stTex + "QUINIENTOS "
Case 6
stTex = stTex + "SEISCIENTOS "
Case 7
stTex = stTex + "SETECIENTOS "
Case 8
stTex = stTex + "OCHOCIENTOS "
Case 9
stTex = stTex + "NOVECIENTOS "
End Select
End If

inTamNum = Len(stParEnt)
If (inTamNum = 8 Or inTamNum = 5 Or inTamNum = 2) Then
inDigDec = CInt(Mid(stParEnt, 1, 1))
stParEnt = Mid(stParEnt, 2, inTamNum - 1)
Select Case inDigDec
Case 1
Select Case Mid(stParEnt, 1, 1)
Case "0"
stTex = stTex + "DIEZ "
Case "1"
stTex = stTex + "ONCE "
Case "2"
stTex = stTex + "DOCE "
Case "3"
stTex = stTex + "TRECE "
Case "4"
stTex = stTex + "CATORCE "
Case "5"
stTex = stTex + "QUINCE "
Case "6"
stTex = stTex + "DIEZ Y SEIS "
Case "7"
stTex = stTex + "DIEZ Y SIETE "
Case "8"
stTex = stTex + "DIEZ Y OCHO "
Case "9"
stTex = stTex + "DIEZ Y NUEVE "
End Select
Case 2
stTex = stTex + "VEINTE "
Case 3
stTex = stTex + "TREINTA "
Case 4
stTex = stTex + "CUARENTA "
Case 5
stTex = stTex + "CINCUENTA "
Case 6
stTex = stTex + "SESENTA "
Case 7
stTex = stTex + "SETENTA "
Case 8
stTex = stTex + "OCHENTA "
Case 9
stTex = stTex + "NOVENTA "
End Select
End If

inTamNum = Len(stParEnt)
If (inTamNum = 7 Or inTamNum = 4 Or inTamNum = 1) Then
inDigUni = CInt(Mid(stParEnt, 1, 1))
stParEnt = Mid(stParEnt, 2, inTamNum - 1)

If (inDigDec > 1 And inDigUni <> 0 And stTex <> "") Then
stTex = Mid(stTex, 1, Len(stTex) - 2) + "I"
End If

If (inDigDec <> 1) Then
Select Case inDigUni
Case 1
Select Case inTamNum
Case 1
stTex = stTex + "UNO "
Case 4, 7
If inTamEnt <> 4 Then
stTex = stTex + "UN "
End If
End Select
Case 2
stTex = stTex + "DOS "
Case 3
stTex = stTex + "TRES "
Case 4
stTex = stTex + "CUATRO "
Case 5
stTex = stTex + "CINCO "
Case 6
stTex = stTex + "SEIS "
Case 7
stTex = stTex + "SIETE "
Case 8
stTex = stTex + "OCHO "
Case 9
stTex = stTex + "NUEVE "
End Select

End If
End If

Select Case inTamNumIni
Case 8, 9
stTex = stTex + "MILLONES "
Case 7
If inDigUni > 1 Then
stTex = stTex + "MILLONES "
Else
stTex = stTex + "MILLON "
End If
Case 4, 5, 6
If (inDigCen > 0 Or inDigDec > 0 Or inDigUni > 0) Then
stTex = stTex + "MIL "
End If
End Select

Loop

If (stParDec = "") Then
stTex = stTex + "CON 00/100"
Else
If Len(stParDec) = 1 Then
stParDec = stParDec & "0"
stTex = stTex + "CON " + stParDec + "/100"
Else
stTex = stTex + "CON " + stParDec + "/100"
End If
End If

fuNumerosLetras = stTex

End Function
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder