تابع تبدیل اعداد مبنای شانزده به مبنای دو

[shirin71]

 
 
Public Function HexToBin(HexNum As String) As String
   Dim BinNum As String
   Dim lHexNum As Long
   Dim i As Integer
   
   On Error GoTo ErrorHandler
   
'  Check the string for invalid characters
   For i = 1 To Len(HexNum)
      If ((Asc(Mid(HexNum, i, 1)) < 48) Or _
          (Asc(Mid(HexNum, i, 1)) > 57 And _
           Asc(UCase(Mid(HexNum, i, 1))) < 65) Or _
          (Asc(UCase(Mid(HexNum, i, 1))) > 70)) Then
         BinNum = ""
         Err.Raise 1016, "HexToBin", "Invalid Input"
      End If
   Next i
   
   i = 0
   lHexNum = Val("&h" & HexNum)
   Do
      If lHexNum And 2 ^ i Then
         BinNum = "1" & BinNum
      Else
         BinNum = "0" & BinNum
      End If
      i = i + 1
   Loop Until 2 ^ i > lHexNum
'  Return BinNum as a String
   HexToBin = BinNum
ErrorHandler:
End Function