Bonjour,

Je viens pour vous partager un petit bout de code que je viens de faire pour palier un manque (bug?) sur VBA

En fait c'est tout simple, j'ai voulu faire l'opération And sur un signé (pour comparer l'état des bits) et le gentil message "Overflow" est apparu quand le bit de signe était à 1 !!!
La fonction ne fonctionne que sur des 16/32 bits


Quelque part dans un module où vous déclarez toutes vos variables publiques, rajoutez ça :
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
Public Enum gv_enumWordOperation
    eAnd = 1
    eOr = 2
    eXor = 3
End Enum

Et voici la fonction :
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
'Permet de faire une operation sur un signé
    '@Param vntValue1 & 2 : Valeurs à comparer
    '@Param lngWordOperation : Enumération de l'opération à exécuter (eAnd/eOr/eXor)
Public Function WordOperation(ByVal vntValue1 As Variant, ByVal vntValue2 As Variant, lngWordOperation As gv_enumWordOperation) As Variant
    Dim blnNegatif(1) As Boolean
    Dim blnEquation As Boolean
    Dim intNbreBits(1) As Integer
    Dim i As Integer
    Dim vntResult As Variant
 
    Select Case TypeName(vntValue1)
        Case "Integer"
            intNbreBits(0) = 15
        Case "Long", "Single"
            intNbreBits(0) = 31
        Case "Currency", "Double"
            intNbreBits(0) = 0
    End Select
 
    Select Case TypeName(vntValue2)
        Case "Integer"
            intNbreBits(1) = 15
        Case "Long", "Single"
            intNbreBits(1) = 31
        Case "Currency", "Double"
            intNbreBits(1) = 1
    End Select
 
    If vntValue1 < 0 Then
        blnNegatif(0) = True
        vntValue1 = vntValue1 + 2 ^ intNbreBits(0)
    End If
 
    If vntValue2 < 0 Then
        blnNegatif(1) = True
        vntValue2 = vntValue2 + 2 ^ intNbreBits(1)
    End If
 
    If intNbreBits(0) <> intNbreBits(1) Then
        Err.Raise 514, , "Les deux valeurs d'entrées doivent être de même longueur de bits (sans jamais dépasser les 32 bits)."
    End If
 
    Select Case lngWordOperation
        Case eAnd
            vntResult = vntValue1 And vntValue2
            If blnNegatif(0) And blnNegatif(1) Then blnEquation = True
 
        Case eOr
            vntResult = vntValue1 Or vntValue2
            If blnNegatif(0) Or blnNegatif(1) Then blnEquation = True
 
        Case eXOr
            vntResult = vntValue1 Xor vntValue2
            If blnNegatif(0) Xor blnNegatif(1) Then blnEquation = True
 
    End Select
 
    If blnEquation Then
        vntResult = vntResult - 2 ^ intNbreBits(0)
    End If
    WordOperation = vntResult
End Function
Pour l'utiliser par exemple :
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Sub test()
    Dim lngMaVar As Long
    Dim lngResult As Long
 
    lngMaVar = CLng("&HFFFF0000")
 
    'Opération And
    lngResult = WordOperation(lngMaVar, CLng("&HF0000000"), eAnd)
    MsgBox "eAnd : " & lngResult
    'Opération Or
    lngResult = WordOperation(lngMaVar, CLng("&HF0000000"), eOr)
    MsgBox "eOr : " & lngResult
    'Opération Xor
    lngResult = WordOperation(lngMaVar, CLng("&HF0000000"), eXor)
    MsgBox "eXor : " & lngResult
End Sub