Public Function Bits_d(ByVal lVal As Long, Optional lDesplazamiento As Integer) As Long
'   //  lVal                Indica el valor ingresado (Base 10).
'   //  lDesplazamiento     Indica la longitud de bit's a dezplazar.
'   //  Bits_d              Retorna el resultado Final (Base 10)
    ...
End Function
 
 

 
Private Sub Form_Load()
Dim lres        As Long
    lres = DebugAndRet(Bits_d(267614144, (-1)))
    lres = DebugAndRet(Bits_d(lres, (-6)))
    lres = DebugAndRet(Bits_d(lres, 2))
    lres = DebugAndRet(Bits_d(lres, 2))
    lres = DebugAndRet(Bits_d(lres, 2))
    lres = DebugAndRet(Bits_d(lres, 2))
    lres = DebugAndRet(Bits_d(lres, (-2)))
    lres = DebugAndRet(Bits_d(lres, (-24)))
End Sub
 
Private Function DebugAndRet(ByVal lVal As Long) As Long
    Debug.Print lVal
    DebugAndRet = lVal
End Function
 
 

 535228288 
-105127936
-26281984
-6570496
-1642624
-410656
-1642624
-2147483648

00001111111100110111011111000000  <-- {267614144}  <--- De este binario se parte...
00011111111001101110111110000000  <-- {-01}
11111001101110111110000000000000  <-- {-06}
11111110011011101111100000000000  <-- {+02}
11111111100110111011111000000000  <-- {+02}
11111111111001101110111110000000  <-- {+02}
11111111111110011011101111100000  <-- {+02}
11111111111001101110111110000000  <-- {-02}
10000000000000000000000000000000  <-- {-24} <-- {-2147483648}

Function SHL(ByVal tStr As Long, ByVal count As Integer) As Long
    Dim Bc As Integer
    Dim Rc As Integer
 
    Bc = Int(count / 4)
    Rc = count Mod 4
    SHL = tStr
 
    For i = 1 To Bc
        SHL = SHL * 16
    Next
 
    For i = 1 To Rc
        SHL = SHL * 2
    Next
End Function
 
Function SHR(ByVal tStr As String, ByVal count As Integer) As String
    Dim Bc As Integer
    Dim Rc As Integer
 
    Bc = Fix(count / 4)
    Rc = count Mod 4
    SHR = tStr
 
    For i = 1 To Bc
        SHR = Fix(SHR / 16)
    Next
 
    For i = 1 To Rc
        SHR = Fix(SHR / 2)
    Next
End Function
 
Function DectoBin(ByVal tStr As String) As String
    Dim cp As Variant
    Dim rval As Double
    tStr = Trim$(tStr)
    DectoBin = ""
 
    rval = Val(tStr)
 
    While rval > 0
        If Mid(tStr, Len(tStr), 1) = "1" Or Mid(tStr, Len(tStr), 1) = "3" Or Mid(tStr, Len(tStr), 1) = "5" Or Mid(tStr, Len(tStr), 1) = "7" Or Mid(tStr, Len(tStr), 1) = "9" Then
            DectoBin = "1" & DectoBin
            rval = rval - 1
        Else
            DectoBin = "0" & DectoBin
        End If
        rval = Fix(rval / 2)
        tStr = Str$(rval)
    Wend
    If DectoBin = "" Then DectoBin = 0
End Function
 
Function BintoDec(ByVal tStr As String) As String
    Dim cp As Double
 
    BintoDec = 0
    cp = 1
 
    For i = Len(tStr) To 1 Step -1
        If i < Len(tStr) Then cp = cp * 2
        BintoDec = BintoDec + Mid(tStr, i, 1) * cp
    Next
End Function
 

 
Private Function Bits_d(ByVal lVal As Long, ByVal lD As Integer) As Long
'   //  lVal    Indica el valor al cual se le dezplazaran los Bit's.
'   //  lD      Indica hacia donde se dezplazan los bits, si son menores a 0 a la izquierda de lo contrario si son mayores a 0 a la derecha.
'   //  Bits_d  Retorna el Valor final con los Bits desplazados.
    If (lD > &H0) And (lD < &H20) Then
        Do
            lVal = SwapBitR(lVal)
            lD = (lD - 1)
        Loop Until (lD = &H0)
    ElseIf (lD < &H0) And (lD > (&HFFFFFFE1)) Then
        Do
            lVal = SwapBitL(lVal)
            lD = (lD + 1)
        Loop Until (lD = &H0)
    ElseIf (lD > &H1F) Then
        If ((lVal And &H80000000) = &H80000000) Then
            lVal = &HFFFFFFFF
        Else
            lVal = &H0
        End If
    ElseIf (lD < &HFFFFFFE1) Then
        lVal = &H0
    End If
    Bits_d = lVal
End Function
 
Public Function SwapBitL(ByVal lVal As Long) As Long
    SwapBitL = (lVal And &H7FFFFFFF)
    If ((SwapBitL And &H40000000) = &H40000000) Then
        SwapBitL = (SwapBitL And &H7FFFFFFF)        'SwapBitL = ((SwapBitL Xor &H40000000) And &H7FFFFFFF)
        SwapBitL = ((SwapBitL + SwapBitL) Or &H80000000)
    Else
        SwapBitL = (SwapBitL + SwapBitL)
    End If
End Function
 
Public Function SwapBitR(ByVal lVal As Long) As Long
    If Not ((lVal And &HFFFFFFFF) = &HFFFFFFFF) Then
        SwapBitR = (lVal \ &H2)
    Else
        SwapBitR = lVal
    End If
End Function
 
 

 
Private Function ShiftL(ByVal bVal As Byte, ByVal lNumOfBits As Long) As Byte
    ShiftL = (bVal * (2 ^ lNumOfBits)) And &HFF ' //  El copymemory se puede sustituir por una mascara...
End Function