Kriptus

Aqui teneis estas interesantisimas rutinas

Const NumChars = "0123456789ABCDEF"

Rem Transforma un número en decimal
Rem S = Número (cualquier base)
Rem NumBase = Número de la Base
Rem 2=Binario, 8=Octal, 10=Decimal, 16=Hexadecimal
Rem Si hay un error, retorna -1.
Function ToDec(ByVal S As String, ByVal NumBase As Integer) As Long
Dim R As Long, I As Integer, P As Integer
R = -1
S = UCase(S)
If (NumBase = 2) Or (NumBase = 8) Or (NumBase = 10) Or (NumBase = 16) Then
R = 0
For I = 1 To Len(S)
P = InStr(NumChars, Mid(S, I, 1))
If (P = 0) Or (P > NumBase) Then
R = -1
Exit For
End If
R = R + (P - 1) * (NumBase ^ (Len(S) - I))
Next I
End If
ToDec = R
End Function

Rem Transforma un número decimal en otras bases
Rem N = Número a convertir
Rem NumBase = Número de la Base
Rem 2=Binario, 8=Octal, 10=Decimal, 16=Hexadecimal
Rem Si hay un error, retorna una cadena vacía.
Function FromDec(ByVal N As Long, ByVal NumBase As Integer) As String
Dim S As String
S = ""
If ((NumBase = 2) Or (NumBase = 8) Or (NumBase = 10) Or (NumBase = 16)) And (N >= 0) Then
Do
S = Mid(NumChars, (N Mod NumBase) + 1, 1) + S
N = Fix(N / NumBase)
Loop Until (N = 0)
End If
FromDec = S
End Function

Rem Convierte de Cualquier base a cualquier base.
Rem N = Núero a convertir
Rem fromBase = Base de origen (2, 8, 10, 16)
Rem toBase = base destino (2, 8, 10, 16)
Function Convert(ByVal N As String, ByVal fromBase As Integer, ToBase As Integer) As String
Dim Nm As Long, S As String
Nm = ToDec(N, fromBase)
If (Nm = -1) Then
S = ""
Else
S = FromDec(Nm, ToBase)
End If
Convert = S
End Function