Iniciar sesiónCerrar
Correo:
Contraseña:
Entrar
Recordar sesión en este navegador
Iniciar sesiónIniciar sesiónCrear cuentaCrear cuenta
LWP » Foros » Visual Basic » Convierte numero a texto

Visual Basic - Convierte numero a texto

Life is soft - evento anual de software empresarial
Volver
Nuevo Tema
<<>>
 
Vista:

Convierte numero a texto

Publicado por Jaime Hernandez (1 intervención) el 27/02/2015 23:19:00
Buena Tarde
Tengo un codigo en VB que convierte un numero en una cadena de texto para usar en una macro en excel, pero tengo el inconveniente que no me muestra la unidad, ni tampoco las cifras mayores a mil millones. aqui el codigo gracias por su ayuda

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
Function Num_texto(Numero)
Dim Texto
Dim MilMillones
Dim Millones
Dim Miles
Dim Cientos
Dim Decimales
Dim Cadena
Dim CadMilMillones
Dim CadMillones
Dim CadMiles
Dim CadCientos
Texto = Numero
Texto = FormatNumber(Texto, 2)
Texto = Right(Space(18) & Texto, 18)
MilMillones = Mid(Texto, 1, 3)
Millones = Mid(Texto, 5, 3)
Miles = Mid(Texto, 9, 3)
Cientos = Mid(Texto, 13, 2)
Decimales = Mid(Texto, 17, 2)
CadMilMillones= ConvierteCifra(MilMillones, 1)
CadMillones = ConvierteCifra(Millones, 1)
CadMiles = ConvierteCifra(Miles, 1)
CadCientos = ConvierteCifra(Cientos, 0)
If Trim(CadMilMillones) > "" Then
If Trim(CadMilMillones) = "UN" Then
Cadena = CadMillones & " MIL MILLONES"
Else
Cadena = CadMillones & " MIL MILLONES"
End If
End If
 
If Trim(CadMillones) > "" Then
If Trim(CadMillones) = "UN" Then
Cadena = CadMillones & " MILLON"
Else
Cadena = CadMillones & " MILLONES"
End If
End If
If Trim(CadMiles) > "" Then
Cadena = Cadena & " " & CadMiles & " MIL"
End If
If Trim(CadMiles & CadCientos) = "UN" Then
Cadena = Cadena & "UNO CON " & Decimales & "/100"
Else
If Miles & Cientos = "000000" Then
Cadena = Cadena & " " & Trim(CadCientos) & " PESOS MCTE  "
Else
Cadena = Cadena & " " & Trim(CadCientos) & " PESOS MCTE  "
End If
End If
Num_texto = Trim(Cadena)
End Function
 
Function ConvierteCifra(Texto, SW)
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 SW 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
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
sin imagen de perfil

Convierte numero a texto

Publicado por Pedro Luis (56 intervenciones) el 28/02/2015 13:29:42
Esta funcion admite numeros de 12 digitos con dos decimales.
se llama asi
variable=letra(numero a considerar)
Con este codigo es facil aumentar el numero de digitos, pudiendo poner despues del mil, millones y despues billones, etc

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
Option Explicit
 
Function Letra(Numero As Double) As String
Dim Pos As Integer, Grupo As String, Num As String, Dec As String
Letra = ""
If Numero > 999999999999.99 Then
Beep
MsgBox "Numero demasiado grande"
Exit Function
End If
If Numero < 1 Then Letra = "CERO "
Dec = Format((Numero - Int(Numero)) * 100, "00")
Num = Trim(CStr(Int(Numero)))
If Len(Num) > 9 Then
 
  'If Mid(Num, 1, Len(Num) - 9) <> "000" Then

    Grupo = Mid(Num, 1, Len(Num) - 9)
    If Grupo = "1" Then Grupo = ""
    Pos = 3
    If Len(Grupo) = 3 Then GoSub Tres
    If Len(Grupo) = 2 Then GoSub Dos
    If Len(Grupo) = 1 Then GoSub Uno
    Letra = Letra & "MIL "
  'End If

  Num = Mid(Num, Len(Num) - 8, 9)
  If Val(Num) Mod 1000000000 = 0 Then
    Letra = Letra & "DE "
  End If
End If
  If Len(Num) > 6 Then
    Grupo = Mid(Num, 1, Len(Num) - 6)
    Pos = 3
    If Len(Grupo) = 3 Then GoSub Tres
    If Len(Grupo) = 2 Then GoSub Dos
    If Len(Grupo) = 1 Then GoSub Uno
 
    If Letra = "UN " Then
      Letra = Letra & "MILLON "
    Else
      Letra = Letra & "MILLONES "
    End If
    Num = Mid(Num, Len(Num) - 5, 6)
    If Val(Num) Mod 1000000 > 0 Then
      Letra = Letra & " "
    Else
      Letra = Letra & "DE "
    End If
  End If
 
  If Len(Num) > 3 Then
    If Mid(Num, 1, Len(Num) - 3) <> "000" Then
      Grupo = Mid(Num, 1, Len(Num) - 3)
      If Grupo = "1" Then Grupo = ""
     Pos = 2
      If Len(Grupo) = 3 Then GoSub Tres
      If Len(Grupo) = 2 Then GoSub Dos
      If Len(Grupo) = 1 Then GoSub Uno
      Letra = Letra & "MIL "
      If Val(Num) Mod 1000 > 0 Then Letra = Letra & " "
    End If
    Num = Mid(Num, Len(Num) - 2, 3)
  End If
  If Len(Num) > 0 Then
    Grupo = Num
    Pos = 1
    If Len(Grupo) = 3 Then GoSub Tres
    If Len(Grupo) = 2 Then GoSub Dos
    If Len(Grupo) = 1 Then GoSub Uno
  End If
  If Val(Dec) > 0 Then
    Letra = Letra + "EUROS CON "
    Grupo = Dec
    'Pos = 1

    GoSub Dos
    GoSub Uno
    Letra = Letra + "CENTIMOS"
  Else
    Letra = Letra + "EUROS "
  End If
Exit Function
'***********************

Uno:
  Select Case Grupo
  Case "1"
    Select Case Pos
      Case 3, 2, 1
        Letra = Letra & "UN "
     ' Case 1 ', 2

     '   Letra = Letra & "UNO" '"UNA"

    End Select
  Case "2"
    Letra = Letra & "DOS "
  Case "3"
    Letra = Letra & "TRES "
    Case "4"
    Letra = Letra & "CUATRO "
    Case "5"
    Letra = Letra & "CINCO "
    Case "6"
    Letra = Letra & "SEIS "
    Case "7"
    Letra = Letra & "SIETE "
    Case "8"
    Letra = Letra & "OCHO "
    Case "9"
    Letra = Letra & "NUEVE "
  End Select
 Return
'****************************

Dos:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
Select Case Grupo
    Case Is < "10"
    Case "10"
      Letra = Letra & "DIEZ "
    Case "11"
      Letra = Letra & "ONCE "
    Case "12"
      Letra = Letra & "DOCE "
    Case "13"
      Letra = Letra & "TRECE "
    Case "14"
      Letra = Letra & "CATORCE "
    Case "15"
      Letra = Letra & "QUINCE "
    Case Is < "20"
      Letra = Letra & "DIECI"
    Case Is = "20"
      Letra = Letra & "VEINTE "
    Case Is < "30"
      Letra = Letra & "VEINTI"
    Case Is < "40"
      Letra = Letra & "TREINTA "
    Case Is < "50"
      Letra = Letra & "CUARENTA "
    Case Is < "60"
      Letra = Letra & "CINCUENTA "
    Case Is < "70"
      Letra = Letra & "SESENTA "
    Case Is < "80"
      Letra = Letra & "SETENTA "
    Case Is < "90"
      Letra = Letra & "OCHENTA "
    Case Is <= "99"
      Letra = Letra & "NOVENTA "
  End Select
If 0 <> Grupo Mod 10 And Grupo > "29" Then
  Letra = Letra & " Y "
End If
If Grupo > "15" Or Grupo < "10" Then
  Grupo = Mid(Grupo, 2, 1)
Else
  Grupo = ""
End If
Return
'*************************

Tres:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
Select Case Grupo
    Case Is < "100"
 
    Case "100"
      Letra = Letra & "CIEN "
    Case Is < "200"
      Letra = Letra & "CIENTO "
    Case Is < "300"
      If Pos = 3 Then
        Letra = Letra & "DOSCIENTOS "
      Else
        Letra = Letra & "DOSCIENTOS " '"DOSCIENTAS "

      End If
    Case Is < "400"
      If Pos = 3 Then
        Letra = Letra & "TRESCIENTOS "
      Else
        Letra = Letra & "TRESCIENTOS " '"TRESCIENTAS "

      End If
    Case Is < "500"
      If Pos = 3 Then
        Letra = Letra & "CUATROCIENTOS "
      Else
        Letra = Letra & "CUATROCIENTOS " '"CUATROCIENTAS "

      End If
    Case Is < "600"
      If Pos = 3 Then
        Letra = Letra & "QUINIENTOS "
      Else
        Letra = Letra & "QUINIENTOS " '"QUINIENTAS "

      End If
    Case Is < "700"
      If Pos = 3 Then
        Letra = Letra & "SEISCIENTOS "
      Else
        Letra = Letra & "SEISCIENTOS " '"SEISCIENTAS "

      End If
    Case Is < "800"
      If Pos = 3 Then
        Letra = Letra & "SETECIENTOS "
      Else
        Letra = Letra & "SETECIENTOS " '"SETECIENTAS "

      End If
    Case Is < "900"
      If Pos = 3 Then
        Letra = Letra & "OCHOCIENTOS "
      Else
        Letra = Letra & "OCHOCIENTOS " '"OCHOCIENTAS "

      End If
    Case Is <= "999"
      If Pos = 3 Then
        Letra = Letra & "NOVECIENTOS "
      Else
        Letra = Letra & "NOVECIENTOS " '"NOVECIENTAS "

      End If
  End Select
Grupo = Mid(Grupo, 2, 2)
Return
 
End Function
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar

Convierte numero a texto

Publicado por JONATHAN JIMÉNEZ (1 intervención) el 18/04/2018 05:39:46
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
Option Explicit
 
Function Letra(Numero As Double) As String
Dim Pos As Integer, Grupo As String, Num As String, Dec As String
Letra = ""
If Numero > 999999999999.99 Then
Beep
MsgBox "Numero demasiado grande"
Exit Function
End If
If Numero < 1 Then Letra = "CERO "
Dec = Format((Numero - Int(Numero)) * 100, "00")
Num = Trim(CStr(Int(Numero)))
If Len(Num) > 9 Then
 
  'If Mid(Num, 1, Len(Num) - 9) <> "000" Then

    Grupo = Mid(Num, 1, Len(Num) - 9)
    If Grupo = "1" Then Grupo = ""
    Pos = 3
    If Len(Grupo) = 3 Then GoSub Tres
    If Len(Grupo) = 2 Then GoSub Dos
    If Len(Grupo) = 1 Then GoSub Uno
    Letra = Letra & "MIL "
  'End If

  Num = Mid(Num, Len(Num) - 8, 9)
  If Val(Num) Mod 1000000000 = 0 Then
    Letra = Letra & ""
  End If
End If
  If Len(Num) > 6 Then
    Grupo = Mid(Num, 1, Len(Num) - 6)
    Pos = 3
    If Len(Grupo) = 3 Then GoSub Tres
    If Len(Grupo) = 2 Then GoSub Dos
    If Len(Grupo) = 1 Then GoSub Uno
 
    If Letra = "UN " Then
      Letra = Letra & "MILLON "
    Else
      Letra = Letra & "MILLONES "
    End If
    Num = Mid(Num, Len(Num) - 5, 6)
    If Val(Num) Mod 1000000 > 0 Then
      Letra = Letra & " "
    Else
      Letra = Letra & "DE "
    End If
  End If
 
  If Len(Num) > 3 Then
    If Mid(Num, 1, Len(Num) - 3) <> "000" Then
      Grupo = Mid(Num, 1, Len(Num) - 3)
      If Grupo = "1" Then Grupo = ""
     Pos = 2
      If Len(Grupo) = 3 Then GoSub Tres
      If Len(Grupo) = 2 Then GoSub Dos
      If Len(Grupo) = 1 Then GoSub Uno
      Letra = Letra & "MIL "
      If Val(Num) Mod 1000 > 0 Then Letra = Letra & " "
    End If
    Num = Mid(Num, Len(Num) - 2, 3)
  End If
  If Len(Num) > 0 Then
    Grupo = Num
    Pos = 1
    If Len(Grupo) = 3 Then GoSub Tres
    If Len(Grupo) = 2 Then GoSub Dos
    If Len(Grupo) = 1 Then GoSub Uno
  End If
  If Val(Num) = 1 Then
    Letra = Letra + "BOLÍVAR "
  End If
  If Val(Num) > 1 Then
    Letra = Letra + "BOLÍVARES "
  End If
  If Val(Num) = 0 Then
    Letra = Letra + "BOLÍVARES "
  End If
  If Val(Dec) = 0 Then
    Letra = Letra + "SIN CÉNTIMOS "
  End If
  If Val(Dec) > 0 Then
    Letra = Letra + "CON "
  End If
  If Val(Dec) > 1 Then
    Grupo = Dec
    'Pos = 1

    GoSub Dos
    GoSub Uno
    Letra = Letra + "CÉNTIMOS"
  End If
  If Val(Dec) = 1 Then
    Grupo = Dec
    'Pos = 1

    GoSub Dos
    GoSub Uno
    Letra = Letra + "CÉNTIMO"
  End If
Exit Function
'***********************

Uno:
  Select Case Grupo
  Case "1"
    Select Case Pos
      Case 3, 2, 1
        Letra = Letra & "UN "
     ' Case 1 ', 2

     '   Letra = Letra & "UNO" '"UNA"

    End Select
  Case "2"
    Letra = Letra & "DOS "
  Case "3"
    Letra = Letra & "TRES "
    Case "4"
    Letra = Letra & "CUATRO "
    Case "5"
    Letra = Letra & "CINCO "
    Case "6"
    Letra = Letra & "SEIS "
    Case "7"
    Letra = Letra & "SIETE "
    Case "8"
    Letra = Letra & "OCHO "
    Case "9"
    Letra = Letra & "NUEVE "
  End Select
 Return
'****************************

Dos:
Select Case Grupo
    Case Is < "10"
    Case "10"
      Letra = Letra & "DIEZ "
    Case "11"
      Letra = Letra & "ONCE "
    Case "12"
      Letra = Letra & "DOCE "
    Case "13"
      Letra = Letra & "TRECE "
    Case "14"
      Letra = Letra & "CATORCE "
    Case "15"
      Letra = Letra & "QUINCE "
    Case Is < "20"
      Letra = Letra & "DIECI"
    Case Is = "20"
      Letra = Letra & "VEINTE "
    Case Is < "30"
      Letra = Letra & "VEINTI"
    Case Is < "40"
      Letra = Letra & "TREINTA "
    Case Is < "50"
      Letra = Letra & "CUARENTA "
    Case Is < "60"
      Letra = Letra & "CINCUENTA "
    Case Is < "70"
      Letra = Letra & "SESENTA "
    Case Is < "80"
      Letra = Letra & "SETENTA "
    Case Is < "90"
      Letra = Letra & "OCHENTA "
    Case Is <= "99"
      Letra = Letra & "NOVENTA "
  End Select
If 0 <> Grupo Mod 10 And Grupo > "29" Then
  Letra = Letra & "Y "
End If
If Grupo > "15" Or Grupo < "10" Then
  Grupo = Mid(Grupo, 2, 1)
Else
  Grupo = ""
End If
Return
Tres:
Select Case Grupo
    Case Is < "100"
 
    Case "100"
      Letra = Letra & "CIEN "
    Case Is < "200"
      Letra = Letra & "CIENTO "
    Case Is < "300"
      If Pos = 3 Then
        Letra = Letra & "DOSCIENTOS "
      Else
        Letra = Letra & "DOSCIENTOS " '"DOSCIENTAS "

      End If
    Case Is < "400"
      If Pos = 3 Then
        Letra = Letra & "TRESCIENTOS "
      Else
        Letra = Letra & "TRESCIENTOS " '"TRESCIENTAS "

      End If
    Case Is < "500"
      If Pos = 3 Then
        Letra = Letra & "CUATROCIENTOS "
      Else
        Letra = Letra & "CUATROCIENTOS " '"CUATROCIENTAS "

      End If
    Case Is < "600"
      If Pos = 3 Then
        Letra = Letra & "QUINIENTOS "
      Else
        Letra = Letra & "QUINIENTOS " '"QUINIENTAS "

      End If
    Case Is < "700"
      If Pos = 3 Then
        Letra = Letra & "SEISCIENTOS "
      Else
        Letra = Letra & "SEISCIENTOS " '"SEISCIENTAS "

      End If
    Case Is < "800"
      If Pos = 3 Then
        Letra = Letra & "SETECIENTOS "
      Else
        Letra = Letra & "SETECIENTOS " '"SETECIENTAS "

      End If
    Case Is < "900"
      If Pos = 3 Then
        Letra = Letra & "OCHOCIENTOS "
      Else
        Letra = Letra & "OCHOCIENTOS " '"OCHOCIENTAS "

      End If
    Case Is <= "999"
      If Pos = 3 Then
        Letra = Letra & "NOVECIENTOS "
      Else
        Letra = Letra & "NOVECIENTOS " '"NOVECIENTAS "

      End If
  End Select
Grupo = Mid(Grupo, 2, 2)
Return
 
End Function
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar