CONVERTER
Novamente estou me confrontando com o código para converter arabians em romanos!!!
De uma olhada!!!
O problema é que qndo o "Valor" recebe um valor, que as vezes se torna negativo!
Para melhor intendimento execute-o com como Debug, para ver o que aconece com as variáveis!
Ficarei muito grato se solucionarem esse problema!!
De uma olhada!!!
O problema é que qndo o "Valor" recebe um valor, que as vezes se torna negativo!
Para melhor intendimento execute-o com como Debug, para ver o que aconece com as variáveis!
Ficarei muito grato se solucionarem esse problema!!
Function DecToRoman(Valor)
Dim aInteiros(13)
Dim aRomanos(13)
Dim i
Dim Result
aInteiros(0) = 1
aInteiros(1) = 4
aInteiros(2) = 5
aInteiros(3) = 9
aInteiros(4) = 10
aInteiros(5) = 40
aInteiros(6) = 50
aInteiros(7) = 90
aInteiros(8) = 100
aInteiros(9) = 400
aInteiros(10) = 500
aInteiros(11) = 900
aInteiros(12) = 1000
aRomanos(0) = "I"
aRomanos(1) = "IV"
aRomanos(2) = "V"
aRomanos(3) = "IX"
aRomanos(4) = "X"
aRomanos(5) = "XL"
aRomanos(6) = "L"
aRomanos(7) = "XC"
aRomanos(8) = "C"
aRomanos(9) = "CD"
aRomanos(10) = "D"
aRomanos(11) = "CM"
aRomanos(12) = "M"
For i = 12 To 0 Step -1
Do While (Valor = aInteiros(i))
Valor = Valor - aInteiros(i)
Result = Result + aRomanos(i)
Loop
Next
DecToRomano = Result
End Function
Public Function DecToRoman(n As Integer) As String
Dim r As String
Dim i As Integer
Dim s As String
Dim p As Integer
Dim d As Integer
If n = 0 Then FormatRoman = "0"
GoTo ExitDTR:
End If
r = "IVXLCDM"
i = Abs(n)
For p = 1 To 5 Step 2
d = i Mod 10
i = i \ 10
Select Case d
Case 0 To 3: s = String(d, Mid(r, p, 1)) & s
Case 4: s = Mid(r, p, 2) & s
Case 5 To 8: s = Mid(r, p + 1, 1) & String(d - 5, Mid(r, p, 1)) & s
Case 9: s = Mid(r, p, 1) & Mid(r, p + 2, 1) & s
End Select
Next
s = String(i, "M") & s
If n 0 Then s = "-" & s
DecToRoman = s
ExitDTR:
r = Empty
i = Empty
s = Empty
d = Empty
p = Empty
End Function
DONATELO,
VOCÃÅ ESTà  POSTANDO MAIS TÓ“PICOS SOBRE O MESMO ASSUNTO. ENCERRE-OS E MANTENHA APENAS UM ATIVO.
A FUNÇÃO ACIMA FAZ EXATAMENTE O QUE VOCÃÅ QUER: CONVERTE INTEIROS EM ALGARISMOS ROMANOS. POR FAVOR, NÃO DUPLIQUE OS TÓ“PICOS.
Dim r As String
Dim i As Integer
Dim s As String
Dim p As Integer
Dim d As Integer
If n = 0 Then FormatRoman = "0"
GoTo ExitDTR:
End If
r = "IVXLCDM"
i = Abs(n)
For p = 1 To 5 Step 2
d = i Mod 10
i = i \ 10
Select Case d
Case 0 To 3: s = String(d, Mid(r, p, 1)) & s
Case 4: s = Mid(r, p, 2) & s
Case 5 To 8: s = Mid(r, p + 1, 1) & String(d - 5, Mid(r, p, 1)) & s
Case 9: s = Mid(r, p, 1) & Mid(r, p + 2, 1) & s
End Select
Next
s = String(i, "M") & s
If n 0 Then s = "-" & s
DecToRoman = s
ExitDTR:
r = Empty
i = Empty
s = Empty
d = Empty
p = Empty
End Function
DONATELO,
VOCÃÅ ESTà  POSTANDO MAIS TÓ“PICOS SOBRE O MESMO ASSUNTO. ENCERRE-OS E MANTENHA APENAS UM ATIVO.
A FUNÇÃO ACIMA FAZ EXATAMENTE O QUE VOCÃÅ QUER: CONVERTE INTEIROS EM ALGARISMOS ROMANOS. POR FAVOR, NÃO DUPLIQUE OS TÓ“PICOS.
Tópico encerrado , respostas não são mais permitidas