use Dec2Bin function in vba ( edit Macro )

[dshoanghuongson]

I would like to use Dec2Bin function in vba for edit Macro
eg:
Sub Macro1
x = 11
v = Dec2Bin (x)
Range("D3").Select
ActiveCell.FormulaR1C1 = v
End Sub
But the Macro when compile indicate error
What should I do for the best result.
dshoanghuongson

 

[shadow12345]

In general, you call Excel functions with application.WorksheetFunction.SomeFunctionName. However, Dec2Bin is special, as it is an Add-In function, and not a pure Excel function. Hence, Application.WorksheetFunction does not work here. Instead, you have to make the functions of the add-in available to your code. To do so, follow these steps

In Excel, menu Tools/Add-Ins, make sure that the add-in Analysis ToolPak - VBA is imported.

Then, set a reference to this add-in in your code: in the VBA editor, menu Tools/References, add a reference to atpvbaen.xls.

Then, your original code, as posted in your quesiton should work just fine.

 

[dshoanghuongson]

In general, you call Excel functions with application.WorksheetFunction.SomeFunctionName. However, Dec2Bin is special, as it is an Add-In function, and not a pure Excel function. Hence, Application.WorksheetFunction does not work here. Instead, you have to make the functions of the add-in available to your code. To do so, follow these steps

In Excel, menu Tools/Add-Ins, make sure that the add-in Analysis ToolPak - VBA is imported.

Then, set a reference to this add-in in your code: in the VBA editor, menu Tools/References, add a reference to atpvbaen.xls.

Then, your original code, as posted in your quesiton should work just fine.

I follow your guide. But the result is the same. Compile error

 

[Case_Germany]

Hi,

without the Analysis ToolPak:

http://www.mrexcel.com/forum/showthread.php?t=321206

 

[Rick Rothstein]

without the Analysis ToolPak:

http://www.mrexcel.com/forum/showthread.php?t=321206

Here is a function I have posted in the past which will accept quite large decimal values, far larger than I could ever imagine anyone needing (see the header comment for details)...

' The DecimalIn argument is limited to 79228162514264337593543950245
' (approximately 96-bits) - large numerical values must be entered
' as a String value to prevent conversion to scientific notation. Then
' optional NumberOfBits allows you to zero-fill the front of smaller
' values in order to return values up to a desired bit level.
Function DecToBin(ByVal DecimalIn As Variant, Optional NumberOfBits As Variant) As String
  DecToBin = ""
  DecimalIn = CDec(DecimalIn)
  Do While DecimalIn <> 0
    DecToBin = Trim$(Str$(DecimalIn - 2 * Int(DecimalIn / 2))) & DecToBin
    DecimalIn = Int(DecimalIn / 2)
  Loop
  If Not IsMissing(NumberOfBits) Then
    If Len(DecToBin) > NumberOfBits Then
      DecToBin = "Error - Number too large for bit size"
    Else
      DecToBin = Right$(String$(NumberOfBits, "0") & _
      DecToBin, NumberOfBits)
    End If
  End If
End Function

If you will never need the optional bit-level setting, the function reduces to this...

' The DecimalIn argument is limited to 79228162514264337593543950245
' (approximately 96-bits) - large numerical values must be entered
' as a String value to prevent conversion to scientific notation.
Function DecToBin(ByVal DecimalIn As Variant) As String
  DecToBin = ""
  DecimalIn = CDec(DecimalIn)
  Do While DecimalIn <> 0
    DecToBin = Trim$(Str$(DecimalIn - 2 * Int(DecimalIn / 2))) & DecToBin
    DecimalIn = Int(DecimalIn / 2)
  Loop
End Function

 

[Rick Rothstein]

Actually, to follow up on my last posting (in case others might find these useful)...

Across the years, I have posted several versions of the following routines. They all have the in common that they can handle huge argument values (see the comments above the function declarations for the various limits). Because the have been developed at widely varying different times, there is no real consistency to error handling (some have it, some don't... those that do may differ in the method). Each of these functions should be able to be used as a UDF in needed. Whether being used as a UDF or a support function for other VB code, note the need to pass large numeric value as strings and the need to receive large numeric return values as strings so as to avoid conversions into scientific notation. Okay, here are the functions...

' The DecimalIn argument is limited to 79228162514264337593543950245
' (approximately 96-bits) - large numerical values must be entered
' as a String value to prevent conversion to scientific notation. Then
' optional NumberOfBits allows you to zero-fill the front of smaller
' values in order to return values up to a desired bit level.
Function DecToBin(ByVal DecimalIn As Variant, Optional NumberOfBits As Variant) As String
  DecToBin = ""
  DecimalIn = CDec(DecimalIn)
  Do While DecimalIn <> 0
    DecToBin = Trim$(Str$(DecimalIn - 2 * Int(DecimalIn / 2))) & DecToBin
    DecimalIn = Int(DecimalIn / 2)
  Loop
  If Not IsMissing(NumberOfBits) Then
    If Len(DecToBin) > NumberOfBits Then
      DecToBin = "Error - Number too large for bit size"
    Else
      DecToBin = Right$(String$(NumberOfBits, "0") & DecToBin, NumberOfBits)
    End If
  End If
End Function

' BinaryString argument can be a maximum of 96 digits (either 0's or 1's)
Function BinToDec(BinaryString As String) As Variant
  Dim X As Integer
  Const TwoToThe48 As Variant = 281474976710656#
  For X = 0 To Len(BinaryString) - 1
  If X > 48 Then
      BinToDec = CDec(BinToDec) + Val(Mid(BinaryString, Len(BinaryString) - X, 1)) * TwoToThe48 * CDec(2 ^ (X - 48))
    Else
      BinToDec = CDec(BinToDec) + Val(Mid(BinaryString, Len(BinaryString) - X, 1)) * CDec(2 ^ X)
    End If
  Next
  If Len(BinToDec) > 10 Then BinToDec = CStr(BinToDec)
End Function

' DecimalIn argument limited to 4951760157141520569681456883
' large numerical values must be entered as a String value
' to prevent conversion to scientific notation.
Function DecToHex(ByVal DecimalIn As Variant) As String
  Dim X As Integer
  Dim BinaryString As String
  Const BinValues = "*0000*0001*0010*0011*0100*0101*0110*0111*1000*1001*1010*1011*1100*1101*1110*1111*"
  Const HexValues = "0123456789ABCDEF"
  Const MaxNumOfBits As Long = 96
  BinaryString = ""
  DecimalIn = Int(CDec(DecimalIn))
  Do While DecimalIn <> 0
    BinaryString = Trim$(Str$(DecimalIn - 2 * Int(DecimalIn / 2))) & BinaryString
    DecimalIn = Int(DecimalIn / 2)
  Loop
  BinaryString = String$((4 - Len(BinaryString) Mod 4) Mod 4, "0") & BinaryString
  For X = 1 To Len(BinaryString) - 3 Step 4
    DecToHex = DecToHex & Mid$(HexValues, (4 + InStr(BinValues, "*" & Mid$(BinaryString, X, 4) & "*")) \ 5, 1)
  Next
End Function

' HexString argument can be a maximum of 23-Hex digits
Function HexToDec(ByVal HexString As String) As Variant
  Dim X As Integer
  Dim BinStr As String
  Const BinValues = "0000000100100011010001010110011110001001101010111100110111101111"
  If Left$(HexString, 2) Like "&[hH]" Then
    HexString = Mid$(HexString, 3)
  End If
  If Len(HexString) <= 23 Then
    For X = 1 To Len(HexString)
      BinStr = BinStr & Mid$(BinValues, 4 * Val("&h" & Mid$(HexString, X, 1)) + 1, 4)
    Next
    HexToDec = CDec(0)
    For X = 0 To Len(BinStr) - 1
      HexToDec = HexToDec + Val(Mid(BinStr, Len(BinStr) - X, 1)) * 2 ^ X
    Next
  Else
    ' Number is too big, handle error here
  End If
End Function

' HexString argument limited only by the maximum length of a VB String
Function HexToBin(HexString As String, Optional WithBlanks As Boolean) As Variant
  Dim X As Integer
  Const BinValues = "0000000100100011010001010110011110001001101010111100110111101111"
  For X = 1 To Len(HexString)
    HexToBin = HexToBin & Mid$(BinValues, 4 * Val("&h" & Mid$(HexString, X, 1)) + 1, 4)
    If WithBlanks Then HexToBin = HexToBin & " "
  Next
End Function

' BinaryString argument limited only by the maximum length of a VB String
Function BinToHex(ByVal BinaryString As String) As String
  Dim X As Integer
  Const BinValues = "*0000*0001*0010*0011*0100*0101*0110*0111*1000*1001*1010*1011*1100*1101*1110*1111*"
  Const HexValues = "0123456789ABCDEF"
  If BinaryString Like "*[!01]*" Then
    BinToHex = "Error - Argument not a binary string"
  Else
    BinaryString = String$((4 - Len(BinaryString) Mod 4) Mod 4, "0") & BinaryString
    For X = 1 To Len(BinaryString) - 3 Step 4
      BinToHex = BinToHex & Mid$(HexValues, (4 + InStr(BinValues, "*" & Mid$(BinaryString, X, 4) & "*")) \ 5, 1)
    Next
  End If
End Function

 

[dshoanghuongson]

Thank you Mr Rick Rothstein!
My Macro run Well.

 

[wagnerl]

Normally when I need to know the binary of a decimal value, it is always interesting to see the hexadecimal value. The function does not use MOD or HEX() for the big number since Microsoft limited it, so it is done manually for very large numbers.

Bino(Value,Bytes)

Value can be any integer decimal number or a cell contained it, small or superbig. Bytes is optional, standard 2, automatic.

=Bino(A1,4)

The number or bytes and bits presented is automatic based on its value, standard minimum of 2 bytes, but you can pad with extra zero bytes at left, using the optional bytes argument. The example above will show A1 with 4 bytes and 32 bits, even if A1 contains a single numeric digit, or will use more bytes and bits if larger than 4.

=Bino(A1)

Will show A1 with a minimum of 2 bytes and 16 bits, or larger if necessary.
For better visualization, binary format has nibbles separated by "-" and bytes by "|"

=Bino(129) = 0x0081 = 0000-0000|1000-0001
=Bino(129,1) = 0x81 = 1000-0001
=Bino(257,1) = 0x0101 = 0000-0001|0000-0001

The function is rigged to insert Error messages into the CELL in case the number is negative or bytes > 10. Can be easily removed or changed.

It helped me while testing VBA simulating lots of math for optimization code for 8 bits microcontrollers (AVR) assembly, creating routines for Sin(x) and Ln(x) with 16 bits precision.

Public Function Bino(ByVal Valo As Double, Optional ByVal Bytes As Long = 2) As String
Dim Conta
Dim Resul as String
Dim Bits
Dim SA As Double
Dim SB As Double
Dim SX As String

If Valo < 0 Then
   Bino = "[Err: Negative]"
   Exit Function
   End If

If Bytes > 4 Then
   Bino = "[Err: Bytes > 10]"
   Exit Function
   End If

ValoHex = ""
SB = Valo
Do While SB > 1
   SA = SB / 16
   ValoHex = Hex(Int(16 * (SA - Int(SA)))) & ValoHex
   SB = SA
Loop

If Len(ValoHex) Mod 2 = 1 Then ValoHex = "0" & ValoHex
Zeroz = Bytes * 2 - Len(ValoHex)
If Zeroz = 2 Then ValoHex = "00" & ValoHex
If Zeroz = 4 Then ValoHex = "0000" & ValoHex
ValoHexLen = Len(ValoHex)
ValoHex = "0x" & ValoHex

If Bytes < ValoHexLen Then Bytes = ValoHexLen / 2
Bits = Bytes * 8 - 1
For Conta = 0 To Bits
    Div = ""
    If Conta And Conta Mod 4 = 0 Then Div = "-"
    If Conta And Conta Mod 8 = 0 Then Div = "|"
    If Int(Valo / 2) = Valo / 2 Then Bitt = 0 Else Bitt = 1
    Resul = Bitt & Div & Resul
    Valo = Int(Valo / 2)
Next Conta

Resul = ValoHex & " = " & Resul
Bino = Resul

End Function