Program to perform decimal to binary conversion ( Use Arrays). Write a VBA progr

Question

Program to perform decimal to binary conversion ( Use Arrays).
Write a VBA program to convert all decimal number in the range 1
to 100 to their binary equivalents.

Explanation / Answer

Not very familiar with VBA but this might help. If it does, please rate Function DecToBin(D As String, Optional bLong As Boolean = False) As String ' converts decimal string D to a 16- or 32-bit binary string Dim i As Long Dim iBin As Long Dim sBin As String Select Case Val(D) Case Is < -2147483648#, Is > 2147483647 Goto TooBig Case Is < -32768, Is > 32767 If Not bLong Then Goto TooBig End Select iBin = CLng(D) For i = IIf(bLong, 31, 15) To 1 Step -1 sBin = sBin & IIf(iBin And 2 ^ (i - 1), "1", "0") Next If iBin < 0 Then DecToBin = "1" & sBin Else i = InStr(1, sBin, "1") DecToBin = Mid(sBin, IIf(i, i, Len(sBin))) End If Exit Function TooBig: DecToBin = "#VALUE!" End Function *************************************** Public Function Dec2Base(Num As Long, base As Long) As String 'converts a decimal number to the equivalent in the specified base '(base 2 to base 16). Base needs to be specified as decimal ie '8 for base 8, 16 for base 16, 2 for base 2 etc Static Digits As Variant Dim i As Long, alHolder() As Long, sTemp As String If IsEmpty(Digits) Then _ Digits = VBA.Array("0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "A", "B", "C", "D", "E", "F") 'check valid base: If base > 16 Then Dec2Base = "Invalid base used": Exit Function 'fill holder array: i = 0 Do Redim Preserve alHolder(0 To i) alHolder(i) = Num Mod base i = i + 1 Num = Num base Loop While Num > 0 'build string result in base: sTemp = "" For i = i - 1 To 0 Step -1 sTemp = sTemp & Digits(alHolder(i)) Next i 'output: Dec2Base = sTemp End Function *************************************************** ' CONVERSION NEEDED FUNCTION ' ------------------------------------------------------ ' Binary to Hex BinToHex(BinNum As String) ' Binary to Octal BinToOct(BinNum As String) ' Binary to Decimal BinToDec(BinNum As String) ' Hex to Binary HexToBin(HexNum As String) ' Octal to Binary OctToBin(OctNum As String) ' Decimal to Binary DecToBin(DecNum As String) ' ' Option Explicit Function BinToHex(BinNum As String) As String Dim BinLen As Integer, i As Integer Dim HexNum As Variant On Error GoTo ErrorHandler BinLen = Len(BinNum) For i = BinLen To 1 Step -1 ' Check the string for invalid characters If Asc(Mid(BinNum, i, 1)) < 48 Or _ Asc(Mid(BinNum, i, 1)) > 49 Then HexNum = "" Err.Raise 1002, "BinToHex", "Invalid Input" End If ' Calculate HEX value of BinNum If Mid(BinNum, i, 1) And 1 Then HexNum = HexNum + 2 ^ Abs(i - BinLen) End If Next i ' Return HexNum as String BinToHex = Hex(HexNum) ErrorHandler: End Function Function BinToOct(BinNum As String) As String Dim BinLen As Integer, i As Integer Dim OctNum As Variant On Error GoTo ErrorHandler BinLen = Len(BinNum) For i = BinLen To 1 Step -1 ' Check the string for invalid characters If Asc(Mid(BinNum, i, 1)) < 48 Or _ Asc(Mid(BinNum, i, 1)) > 49 Then OctNum = "" Err.Raise 1002, "BinToOct", "Invalid Input" End If ' Calculate Octal value of BinNum If Mid(BinNum, i, 1) And 1 Then OctNum = OctNum + 2 ^ Abs(i - BinLen) End If Next i ' Return OctNum as String BinToOct = Oct(OctNum) ErrorHandler: End Function Public Function BinToDec(BinNum As String) As String Dim i As Integer Dim DecNum As Long On Error GoTo ErrorHandler ' Loop thru BinString For i = Len(BinNum) To 1 Step -1 ' Check the string for invalid characters If Asc(Mid(BinNum, i, 1)) < 48 Or _ Asc(Mid(BinNum, i, 1)) > 49 Then DecNum = "" Err.Raise 1002, "BinToDec", "Invalid Input" End If ' If bit is 1 then raise 2^LoopCount and add it to DecNum If Mid(BinNum, i, 1) And 1 Then DecNum = DecNum + 2 ^ (Len(BinNum) - i) End If Next i ' Return DecNum as a String BinToDec = DecNum ErrorHandler: End Function Public Function OctToBin(OctNum As String) As String Dim BinNum As String Dim lOctNum As Long Dim i As Integer On Error GoTo ErrorHandler ' Check the string for invalid characters For i = 1 To Len(OctNum) If (Asc(Mid(OctNum, i, 1)) < 48 Or Asc(Mid(OctNum, i, 1)) > 55) Then BinNum = "" Err.Raise 1008, "OctToBin", "Invalid Input" End If Next i i = 0 lOctNum = Val("&O" & OctNum) Do If lOctNum And 2 ^ i Then BinNum = "1" & BinNum Else BinNum = "0" & BinNum End If i = i + 1 Loop Until 2 ^ i > lOctNum ' Return BinNum as a String OctToBin = BinNum ErrorHandler: End Function Public Function DecToBin(DecNum As String) As String Dim BinNum As String Dim lDecNum As Long Dim i As Integer On Error GoTo ErrorHandler ' Check the string for invalid characters For i = 1 To Len(DecNum) If Asc(Mid(DecNum, i, 1)) < 48 Or _ Asc(Mid(DecNum, i, 1)) > 57 Then BinNum = "" Err.Raise 1010, "DecToBin", "Invalid Input" End If Next i i = 0 lDecNum = Val(DecNum) Do If lDecNum And 2 ^ i Then BinNum = "1" & BinNum Else BinNum = "0" & BinNum End If i = i + 1 Loop Until 2 ^ i > lDecNum ' Return BinNum as a String DecToBin = BinNum ErrorHandler: End Function 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 *************************************************************** http://snippets.dzone.com/posts/show/7763 ****************************************************************** GOOD LUCK

Related Questions

Navigate

• Browse (All)
• Browse P
• Subjects

---

---

Integrity-first tutoring: explanations and feedback only — we do not complete graded work. Learn more.