• Home
 · 
• String Manipulation
 · 
• This is would convert numbers whitout any overflowing problems (Dec,Bin,Hex,Oct)

This is would convert numbers whitout any overflowing problems (Dec,Bin,Hex,Oct)

This is would convert numbers whitout any overflowing problems (Dec,Bin,Hex,Oct)

Rate This is would convert numbers whitout any overflowing problems (Dec,Bin,Hex,Oct)

• 1
• 2
• 3
• 4
• 5

(1(1 Vote))

'I recomend to put this in a module and add to a proyect when you need it
'But I works anywhere
'This code dont present to you the overflow error
'So is a great advantage to convert very large numbers
'This code you need to copy all if you want to all the function work correctly
'If you don't it will present some problem if the last ones

Function HextoBin(ByVal Numero As String) As String
Dim Bin, Res As String
Dim a As Long
 For a = Len(Trim(Numero)) To 1 Step -1
  Select Case Mid(Numero, a, 1)
  Case "0": Bin = "0000"
  Case "1": Bin = "0001"
  Case "2": Bin = "0010"
  Case "3": Bin = "0011"
  Case "4": Bin = "0100"
  Case "5": Bin = "0101"
  Case "6": Bin = "0110"
  Case "7": Bin = "0111"
  Case "8": Bin = "1000"
  Case "9": Bin = "1001"
  Case "A": Bin = "1010"
  Case "B": Bin = "1011"
  Case "C": Bin = "1100"
  Case "D": Bin = "1101"
  Case "E": Bin = "1110"
  Case "F": Bin = "1111"
  Case Else
  m = MsgBox("Su Numero no es Hexadecimal", vbCritical, "Error")
  Exit For
  End Select
 Res = Bin + Res
 Next a
 For a = 1 To Len(Res)
  If Mid(Res, a, 1) = "1" Then Exit For
  Next a
  Res = Mid(Res, a, Len(Res) - a + 1)
  If Res = "" Then Res = "0"
HextoBin = Res
End Function

Function OcttoBin(ByVal Numero As String) As String
Dim Bin, Res As String
Dim a As Long
 For a = Len(Trim(Numero)) To 1 Step -1
  Select Case Mid(Numero, a, 1)
  Case "0": Bin = "000"
  Case "1": Bin = "001"
  Case "2": Bin = "010"
  Case "3": Bin = "011"
  Case "4": Bin = "100"
  Case "5": Bin = "101"
  Case "6": Bin = "110"
  Case "7": Bin = "111"
  Case Else
  m = MsgBox("Su Numero no es Octal", vbCritical, "Error")
  Exit For
  End Select
 Res = Bin + Res
 Next a
 For a = 1 To Len(Res)
  If Mid(Res, a, 1) = "1" Then Exit For
  Next a
  Res = Mid(Res, a, Len(Res) - a + 1)
  If Res = "" Then Res = "0"
OcttoBin = Res
End Function

Function BintoHex(ByVal Numero As String) As String
Dim Hex, Res As String
Dim a, Conv As Long
Conv = 4 - (Len(Numero) - (Int(Len(Numero) / 4) * 4))
If Conv > 0 Then
For a = 1 To Conv
Numero = "0" + Numero
Next a
End If
For a = Len(Trim(Numero)) To 1 Step -4
 Select Case Val(Mid(Numero, a - 3, 4))
 Case 0: Hex = "0"
 Case 1: Hex = "1"
 Case 10: Hex = "2"
 Case 11: Hex = "3"
 Case 100: Hex = "4"
 Case 101: Hex = "5"
 Case 110: Hex = "6"
 Case 111: Hex = "7"
 Case 1000: Hex = "8"
 Case 1001: Hex = "9"
 Case 1010: Hex = "A"
 Case 1011: Hex = "B"
 Case 1100: Hex = "C"
 Case 1101: Hex = "D"
 Case 1110: Hex = "E"
 Case 1111: Hex = "F"
 Case Else
 m = MsgBox("Su Numero no es Binario")
 Exit For
 End Select
 Res = Hex + Res
 Next a
 If Res = "" Then Res = "0"
BintoHex = Res
 End Function

Function BintoOct(ByVal Numero As String) As String
Dim Oct, Res As String
Dim a, Conv As Long
Conv = 3 - (Len(Numero) - (Int(Len(Numero) / 3) * 3))
If Conv > 0 Then
For a = 1 To Conv
Numero = "0" + Numero
Next a
End If
For a = Len(Trim(Numero)) To 1 Step -3
 Select Case Val(Mid(Numero, a - 2, 3))
 Case 0: Oct = "0"
 Case 1: Oct = "1"
 Case 10: Oct = "2"
 Case 11: Oct = "3"
 Case 100: Oct = "4"
 Case 101: Oct = "5"
 Case 110: Oct = "6"
 Case 111: Oct = "7"
 Case Else
 m = MsgBox("Su Numero no es Binario")
 Exit For
 End Select
 Res = Oct + Res
 Next a
 If Res = "" Then Res = "0"
BintoOct = Trim(Str(Val(Res)))
 End Function
 
Function DectoBin(ByVal Numero As String) As String
Dim Res As String
Dim Conv As Long
If IsNumeric(Numero) Then
If Val(Numero) = 0 Then DectoBin = 0: Exit Function
Do While Not Val(Numero) = 0
Conv = Val(Numero) - (Int(Val(Numero) / 2) * 2)
If Conv = 0 Then
Res = "0" + Res: Numero = Str(Int(Val(Numero) / 2))
Else
Res = "1" + Res: Numero = Str(Int((Val(Numero) - 1) / 2))
End If
If Val(Numero) = 1 Then Res = "1" + Res: Exit Do
Loop
DectoBin = Res
Else
m = MsgBox("Su numero no es Decimal", vbCritical, "Error")
End If
End Function

Function BintoDec(ByVal Numero As String) As String
Dim Res As String
Dim a, Base As Long
Base = 0
For a = Len(Numero) To 1 Step -1
If Mid(Numero, a, 1) = "1" Then
Res = Str(Val(Res) + (2 ^ Base))
ElseIf mid(Numero) <> "0" Then
m = MsgBox("Su Numero no es Binario", vbCritical, "Error")
BintoDec = 0: Exit Function
End If
Base = Base + 1
Next a
BintoDec = Res
End Function

Function DectoHex(ByVal Numero As String) As String
DectoHex = DectoBin(BintoHex(Numero))
End Function

Function DectoOct(ByVal Numero As String) As String
DectoOct = DectoBin(BintoOct(Numero))
End Function

Function HextoDec(ByVal Numero As String) As String
HextoDec = HextoBin(BintoDec(Numero))
End Function

Function OcttoDec(ByVal Numero As String) As String
OcttoDec = OcttoBin(BintoDec(Numero))
End Function

Function HextoOct(ByVal Numero As String) As String
HextoOct = BintoOct(HextoBin(Numero))
End Function

Function OcttoHex(ByVal Numero As String) As String
OcttoHex = BintoHex(OcttoBin(Numero))
End Function

'This code is provided by Luis
'[email protected]