Option Explicit

Public Function setBase(dummy As String, bMode As String, _
      lMode As String) As String

  On Error GoTo errHandler1

  Dim fi As Integer
  Dim erg
  Dim erg2
  Dim sum As String
  Dim sum2 As String
  Dim zDummy

  If lMode = "dec" Then
    If bMode = "bin" Then
      zDummy = CDec(dummy)
      erg = zDummy
      While Not zDummy <= 0
        zDummy = zDummy / 2
        For fi = 1 To Len(zDummy)
          If Mid(zDummy, fi, 1) = "," Xor _
                Mid(zDummy, fi, 1) = "." Then
            zDummy = Left(zDummy, fi - 1)
            Exit For
          End If
        Next fi
        erg = erg - (zDummy * 2)
        sum = erg & sum
        erg = zDummy
      Wend
      setBase = sum
      Exit Function
    ElseIf bMode = "hex" Then
      zDummy = CDec(dummy)
      erg = zDummy
      While Not zDummy <= 0
        zDummy = zDummy / 16
        For fi = 1 To Len(zDummy)
          If Mid(zDummy, fi, 1) = "," Xor _
                Mid(zDummy, fi, 1) = "." Then
            zDummy = Left(zDummy, fi - 1)
            Exit For
          End If
        Next fi
        erg = erg - (zDummy * 16)
        sum = Dec2Hex(erg) & sum
        erg = zDummy
      Wend
      setBase = sum
      Exit Function
    End If

  ElseIf lMode = "bin" Then
    If bMode = "dec" Then
      zDummy = dummy
      erg = 0
      For fi = Len(dummy) To 1 Step -1
        zDummy = Mid(dummy, fi, 1) * (2 ^ erg)
        erg = erg + 1
        erg2 = erg2 + zDummy
      Next fi
      setBase = erg2
      Exit Function
    ElseIf bMode = "hex" Then
      sum2 = ""
      If Len(dummy) Mod 4 <> 0 Then
        While Len(dummy) Mod 4 <> 0
          dummy = "0" & dummy
        Wend
      End If
      For fi = 1 To Len(dummy) Step 4
        sum = Mid$(dummy, fi, 4)
        sum2 = sum2 & Bin2Hex(sum)
      Next fi
      setBase = sum2
      Exit Function
    End If

  ElseIf lMode = "hex" Then
    If bMode = "bin" Then
      sum2 = ""
      For fi = 1 To Len(dummy)
        sum = Mid$(dummy, fi, 1)
        sum2 = sum2 & Hex2Bin(sum)
      Next fi
      setBase = sum2
      Exit Function
    ElseIf bMode = "dec" Then
      zDummy = dummy
      erg = 0
      For fi = Len(dummy) To 1 Step -1
        zDummy = Hex2Dec(Mid(dummy, fi, 1)) * (16 ^ erg)
        erg = erg + 1
        erg2 = erg2 + zDummy
      Next fi
      setBase = erg2
      Exit Function
    End If
  End If

errHandler1:
  MsgBox "Fehler-Nr.: " & Err.Number & ", " & vbCrLf & _
        "Beschreibung : " & Err.Description, vbCritical, "Fehler"
End Function

Private Function Bin2Hex(bx As String) As String
  Select Case bx
    Case "0000": Bin2Hex = "0": Case "0001": Bin2Hex = "1"
    Case "0010": Bin2Hex = "2": Case "0011": Bin2Hex = "3"
    Case "0100": Bin2Hex = "4": Case "0101": Bin2Hex = "5"
    Case "0110": Bin2Hex = "6": Case "0111": Bin2Hex = "7"
    Case "1000": Bin2Hex = "8": Case "1001": Bin2Hex = "9"
    Case "1010": Bin2Hex = "A": Case "1011": Bin2Hex = "B"
    Case "1100": Bin2Hex = "C": Case "1101": Bin2Hex = "D"
    Case "1110": Bin2Hex = "E": Case "1111": Bin2Hex = "F"
  End Select
End Function

Private Function Hex2Bin(hx As String) As String
  Select Case hx
    Case "0": Hex2Bin = "0000": Case "1": Hex2Bin = "0001"
    Case "2": Hex2Bin = "0010": Case "3": Hex2Bin = "0011"
    Case "4": Hex2Bin = "0100": Case "5": Hex2Bin = "0101"
    Case "6": Hex2Bin = "0110": Case "7": Hex2Bin = "0111"
    Case "8": Hex2Bin = "1000": Case "9": Hex2Bin = "1001"
    Case "A": Hex2Bin = "1010": Case "B": Hex2Bin = "1011"
    Case "C": Hex2Bin = "1100": Case "D": Hex2Bin = "1101"
    Case "E": Hex2Bin = "1110": Case "F": Hex2Bin = "1111"
  End Select
End Function

Private Function Dec2Hex(rest As Variant) As String
  Select Case rest
    Case "0":  Dec2Hex = "0": Case "1":  Dec2Hex = "1"
    Case "2":  Dec2Hex = "2": Case "3":  Dec2Hex = "3"
    Case "4":  Dec2Hex = "4": Case "5":  Dec2Hex = "5"
    Case "6":  Dec2Hex = "6": Case "7":  Dec2Hex = "7"
    Case "8":  Dec2Hex = "8": Case "9":  Dec2Hex = "9"
    Case "10": Dec2Hex = "A": Case "11": Dec2Hex = "B"
    Case "12": Dec2Hex = "C": Case "13": Dec2Hex = "D"
    Case "14": Dec2Hex = "E": Case "15": Dec2Hex = "F"
  End Select
End Function

Private Function Hex2Dec(zH As String) As String
  Select Case zH
    Case "0": Hex2Dec = "0":  Case "1": Hex2Dec = "1"
    Case "2": Hex2Dec = "2":  Case "3": Hex2Dec = "3"
    Case "4": Hex2Dec = "4":  Case "5": Hex2Dec = "5"
    Case "6": Hex2Dec = "6":  Case "7": Hex2Dec = "7"
    Case "8": Hex2Dec = "8":  Case "9": Hex2Dec = "9"
    Case "A": Hex2Dec = "10": Case "B": Hex2Dec = "11"
    Case "C": Hex2Dec = "12": Case "D": Hex2Dec = "13"
    Case "E": Hex2Dec = "14": Case "F": Hex2Dec = "15"
  End Select
End Function