تابع تبدیل باینری به BCD

Private Function BinaryToBcd(ByVal strBinary As String) As Long
Dim lngResult As Long
Dim lngCount As Long, intP As Long
    intP = 0
   
    For lngCount = Trim(Len(strBinary)) To 1 Step -1
        lngResult = lngResult + ((Val(Mid(strBinary, lngCount, 1))) * (2 ^ intP))
        intP = intP + 1
    Next lngCount
BinaryToBcd = lngResult
End Function