Iniciar sesiónCerrar
Correo:
Contraseña:
Entrar
Recordar sesión en este navegador
Iniciar sesiónIniciar sesiónCrear cuentaCrear cuenta
LWP » Foros » Visual Basic para Aplicaciones » Convertir arábigo a romano

Visual Basic para Aplicaciones - Convertir arábigo a romano

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

Convertir arábigo a romano

Publicado por Cristina (8 intervenciones) el 20/02/2018 16:15:43
Hola y gracias por adelantado.

Tengo el siguiente código en VBA Word 2016. Lo que hace es ir contando cuántos Apéndices y Anexos tiene el documento y va añadiendo "Apéndice A", "Apéndice B", etc. El problema es que los Anexos se numeran con números romanos y no sé cómo convertir de arábigo a romano.

1
2
3
4
5
6
7
8
9
If Selection.Style = "Apéndice" Then
        apen = apen + 1
        Cap = "Apéndice " & Chr(64 + apen)
End If
 
If Selection.Style = "Anexo" Then
        ane = ane + 1
        Cap = "Anexo" & AQUI DEBERIA IR EL NUMERO ARABIGO DE ane EN ROMANO
End If
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

Convertir arábigo a romano

Publicado por Cristina (8 intervenciones) el 20/02/2018 16:35:55
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
*****Aclaro el mensaje*****
 
If Selection.Style = "Apéndice" Then
    apen = apen + 1
    Cap = "Apéndice " & Chr(64 + apen)
End If
 
If Selection.Style = "Anexo" Then
    ane = ane + 1
    Select Case ane           'Ahora lo estoy haciendo con este apaño

        Case Is = 1                ' pero seguro que habrá una forma mejor (digo yo...) 

            anerom = " I"
        Case Is = 2
            anerom = " II"
        Case Is = 3
            anerom = " III"
     End Select
    Cap = "Anexo" & anerom
End If
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
Imágen de perfil de Antoni Masana
Val: 1.134
Oro
Ha mantenido su posición en Visual Basic para Aplicaciones (en relación al último mes)
Gráfica de Visual Basic para Aplicaciones

Convertir arábigo a romano

Publicado por Antoni Masana (498 intervenciones) el 20/02/2018 21:57:18
Puedes hacer una tabla de conversión.

He recordado que hace tiempo hice un programa que sacaba los números del 1 al 4000 en romano.
El código es en QBasic pero te lo convierto para que lo uses en Visual Basic

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
Function Unidad(Uni as Integer) As String
    Dim U as String
    SELECT CASE Uni
        CASE 0: U = ""
        CASE 1: U = "I"
        CASE 2: U = "II"
        CASE 3: U = "III"
        CASE 4: U = "IV"
        CASE 5: U = "V"
        CASE 6: U = "VI"
        CASE 7: U = "VII"
        CASE 8: U = "VIII"
        CASE 9: U = "IX"
   END SELECT
   Unidad = U
End Function
 
Function Decena(Dec as Integer) As String
    Dim D as String
    SELECT CASE Dec
        CASE 0: D = ""
        CASE 1: D = "X"
        CASE 2: D = "XX"
        CASE 3: D = "XXX"
        CASE 4: D = "IL"
        CASE 5: D = "L"
        CASE 6: D = "LX"
        CASE 7: D = "LXX"
        CASE 8: D = "LXXX"
        CASE 9: D = "XC"
   END SELECT
   Decena = D
End Function
 
Function Centena(Cen as Integer) As String
    Dim C as String
    SELECT CASE Cen
        CASE 0: C = ""
        CASE 1: C = "C"
        CASE 2: C = "CC"
        CASE 3: C = "CCC"
        CASE 4: C = "CD"
        CASE 5: C = "D"
        CASE 6: C = "DC"
        CASE 7: C = "DCC"
        CASE 8: C = "DCCC"
        CASE 9: C = "CM"
   END SELECT
   Centena = C
End Function
 
Function Millares(Mil as Integer) As String
    Dim M as String
    SELECT CASE Mil
        CASE 0: M = ""
        CASE 1: M = "M"
        CASE 2: M = "MM"
        CASE 3: M = "MMM"
   END SELECT
   Millares = M
End Function

Con estas funciones solo tiene que hacer

1
2
3
4
5
6
7
If Selection.Style = "Anexo" Then
   ane = ane + 1
   Cen = ane \ 100
   Dec = (ane Mod 100) \ 10
   Uni = (ane Mod 100) Mod 10
   Cap = "Anexo" & Centena(Cen) + Decena(Dec) + Unidad(Uni)
End If

Y con esto tienes cubierto hasta el anexo 999

Saludos.
\\//_
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

Convertir arábigo a romano

Publicado por Cristina (8 intervenciones) el 22/02/2018 17:11:02
Muchas gracias, así está más claro y queda el código mucho más limpio.
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