Private Function Dec2Bin(ByVal Dec As Long, ByVal NumDigitsMin As Long) As _
  String
    On Error GoTo Dec2BinError
 
    Dim i As Long
 
    ' Binären String zusammensetzen
    Do
        If (Dec And 2 ^ i) > 0 Then ' Bit ist zu setzen
            Dec2Bin = "1" & Dec2Bin  ' "1" setzen
            Dec = Dec - 2 ^ i ' Subtrahieren für Abbruchbedingung
        Else
            Dec2Bin = "0" & Dec2Bin ' "0" setzen
        End If
        i = i + 1 ' Nächste Position
    Loop Until Dec = 0 ' Abbruchbedingung prüfen
    ' Falls minimale Länge unterschritten, mit "0" auffüllen
    Dec2Bin = Format$(Dec2Bin, String(NumDigitsMin, "0"))
Dec2BinExit:
 
    Exit Function
Dec2BinError:
    With Err
        .Raise .Number, .Source, .Description, .HelpFile, .HelpContext
    End With
    Resume Dec2BinExit
End Function

Private Function Bin2Dec(ByVal Bin As String) As Long
    On Error GoTo Bin2DecError
 
    Dim i As Long
    Dim lngLen As Long
 
    lngLen = Len(Bin)
    If Right(Bin, 1) = "," Then
        Bin = Left(Bin, lngLen - 1)
        lngLen = lngLen - 1
    End If
 
    ' Binärstring zerlegen
    For i = lngLen To 1 Step -1 ' Wir gehen von rechts nach links vor (LSB 
    ' -> MSB)
        Bin2Dec = Bin2Dec + IIf(Mid$(Bin, i, 1) = "1", 2 ^ (lngLen - i), 0)
    Next i
 
Bin2DecExit:
    Exit Function
Bin2DecError:
    ' Wird (beispielsweise) bei Bereichsüberschreitung des Long-Datentyps 
    ' gefeuert
    With Err
        .Raise .Number, .Source, .Description, .HelpFile, .HelpContext
    End With
    Resume Bin2DecExit
  End Function

Private Sub Command1_Click()
 
    'von ascii nach binär umwandeln
 
    Dim l As Long
    Dim sa As String
    Dim sb As String
    Dim lZahl As Long
 
    Me.MousePointer = 11
 
    sa = Text1.Text
    Text2.Text = ""
 
    For l = 1 To Len(sa)
        lZahl = Asc(Mid(sa, l, 1))  'ein zeichen heraussuchen
        sb = sb & Dec2Bin(lZahl, 8) 'zeichen in 8 bit zahl umwandeln
    Next l
 
    Text2.Text = sb
    Text1.Text = ""
 
    Me.MousePointer = 0
 
End Sub

Private Sub Command2_Click()
 
    'von binär nach ascii umwandeln
 
    Dim l As Long
    Dim sa As String
    Dim sb As String
    Dim sc As String
 
    Me.MousePointer = 11
 
    sa = Text2.Text
    Text1.Text = ""
 
    For l = 1 To Len(sa) Step 8 'schleife in 8ter sprüngen durchlaufen
        sb = Mid(sa, l, 8)  '8 bit zahl heraussuchen
        sb = Bin2Dec(sb)    'funktionsaufruf bin to dec
        sc = sc & Chr(sb)   'ascii-code in zeichen umwandeln
    Next l
 
    Text1.Text = sc
    Text2.Text = ""
 
    Me.MousePointer = 0
 
End Sub