Sub GanzeZahlBinaerAusgeben2()
'Eingabe: ganze Zahl (long)
'Ausgabe: Zahl in binärer Darstellung
Dim s_Zahl As String, s As String, x As Long
Dim l_zahl As Long, s_binaer As String, d_zahl As Double
Dim l_test As Long, s_tmp As String, l_cnt As Long
Dim myDaten As DataObject
->Zahl eingeben (long)
Do
s_Zahl = InputBox( _
Für welche Zahl soll der Code angezeigt werden? & vbLf & _
(Bereich: -2.147.483.648 bis 2.147.483.647), _
ganze Zahl in binäre Darstellung wandeln, _
)
If s_Zahl = Then Exit Sub
->Prüfen auf ganze Zahl
For x = 1 To Len(s_Zahl)
s = Mid(s_Zahl, x, 1)
Select Case s
Case -: If x <> 1 Then GoTo MeldungKeineZahl
Case 0 To 9
Case Else: GoTo MeldungKeineZahl
End Select
Next
d_zahl = s_Zahl
If -2147483648# > d_zahl Or d_zahl > 2147483647 Then GoTo MeldungKeineZahl
Exit Do->Ist ganze Zahl
MeldungKeineZahl:
MsgBox (Bitte geben Sie eine ganze Zahl ein.)
Loop
l_zahl = s_Zahl
->in binaer wandeln
s_binaer =
For x = 30 To 0 Step -1
l_test = l_zahl And (2 ^ x)
If l_test > 0 Then s_binaer = s_binaer & 1 Else s_binaer = s_binaer & 0
Next
->Bei negativer Zahl Bit für Vorzeichen setzen
If l_zahl < 0 Then s_binaer = 1 & s_binaer
->ggf. führende 0en abschneiden
For x = 1 To Len(s_binaer)
If Left(s_binaer, 1) = 0 Then s_binaer = Right(s_binaer, Len(s_binaer) - 1)
Next
->Formatierung:
->ein Leerzeichen vor jeweils 8 Digits
s_tmp = : l_cnt = 0
For x = Len(s_binaer) To 1 Step -1
s_tmp = Mid(s_binaer, x, 1) & s_tmp
l_cnt = l_cnt + 1
If l_cnt Mod 8 = 0 And x <> 1 Then s_tmp = & s_tmp
Next x
s_binaer = s_tmp
->Meldung
MsgBox ( _
Die Zahl & s_Zahl & lautete binaer: & vbLf & vbLf & _
s_binaer & vbLf & vbLf & _
Die binäre Zahl ist in der Zwischenablage)
->binären Wert in Zwischenablage kopieren
Set myDaten = New DataObject: myDaten.SetText s_binaer: myDaten.PutInClipboard
End Sub