Binary to Decimal and Decimal to Binary conversions

Public Function BinaryToDecimal(Binary As String) As Long
Dim n As Long
Dim s As Integer
For s = 1 To Len(Binary)
n = n + (Mid(Binary, Len(Binary) - s + 1, 1) * (2 ^ (s - 1)))
Next s

BinaryToDecimal = n
End Function

Public Function DecimalToBinary(DecimalNum As Long) As String
Dim tmp As String
Dim n As Long

n = DecimalNum

tmp = Trim(Str(n Mod 2))
n = n \ 2

Do While n <> 0
tmp = Trim(Str(n Mod 2)) & tmp
n = n \ 2
Loop

DecimalToBinary = tmp
End Function

Binary to Hexadecimal

Public Function toHex(s As String)
   'Converts a binary string to base 16
   Dim sResult As String
   Dim nCnt As Integer
   For nCnt = 1 To Len(s)
       sResult = sResult & Right("00" & Hex(Asc(Mid(s, nCnt, 1))), 2)
   Next
   toHex = sResult
End Function

Public Function toBinary(s As String)
   'Converts hex pairs to binary
   Dim sResult As String
   Dim nCnt As Integer
   For nCnt = 1 To Len(s) Step 2
       sResult = sResult & Chr(Val("&H" & Mid(s, nCnt, 2)))
   Next
   toBinary = sResult
End Function

}

Hexadecimal Number to Binary

Private Sub Command1_Click()

Dim lngX As Long

Dim lngY As Long

Dim strBinary As

String

lngX = &HAAAAAAAA

lngY = 1
On Error Resume Next
strBinary = ""
Do While Err.Number = 0
If lngX And lngY Then
strBinary = "1" & strBinary
Else
strBinary = "0" & strBinary
End If
lngY = lngY + lngY
Loop

If lngX And &H80000000 Then
strBinary = "1" & strBinary
Else
strBinary = "0" & strBinary
End If

MsgBox strBinary


End Sub