Convertir un nombre decimal en IEEE754 binary64

Bonjour à tous,

Cela doit être mon premier message, mais je lis et j'ai déjà puiser de nombreux conseils ou astuces sur le site/forum.

J'en profite de vous remercier.

J'aimerais pouvoir convertir un nombre décimal en résultat IEEE754 64 bits pour un besoin professionnel.

Exemple:

133.7194 --> 4060B705532617C2

Ce site permet de faire la conversion par exemple (j'aimerais pouvoir faire la même chose sur excel):

Il y a peut-être, même certainement, une fonction VBA existante pour cela. Mais je n'ai pas trouver, peut-être car je n'ai pas utilisé les bons mots clefs, ou que la réponse est tellement évidente qu'un novice comme moi ne l'a pas remarqué.

Est-ce que quelqu'un pourrait m'aider ou me renseigner?

Pour info, cette fonction me permettra de traiter et gérer les paramètres d'une machine CNC FANUC, le format d'entré des données doit être :

Ex: G10L86P109(402E000000000000)

Merci

Bonne journée

bonjour,

Type ndouble
    a As Double
End Type
Type n8b
    a As Long
    b As Long
End Type
Sub test()
'avec Lset, instruction dont j'avais oublié l'existence
    Dim nombre As ndouble, data8 As n8b
    nombre.a = 133.7194

    LSet data8 = nombre

    MsgBox Hex(data8.b) & Hex(data8.a)
End Sub

Sub testf()
'en passant par un fichier
    Dim nombre As ndouble, data8 As n8b
    nombre.a = 133.7194
    Open "test.bin" For Random As 1
    Put 1, , nombre
    Get 1, 1, data8
    Close
    MsgBox Hex(data8.b) & Hex(data8.a)
End Sub

Bonjour,

Conversion en IEEE754 Simple ou Double avec ce code (que j'avais trouvé sur le net je ne sais plus où) :

Private Type TDouble
  Value As Double
End Type

Private Type TSingle
  Value As Single
End Type

Private Type DArray
  Value(1 To 8) As Byte
End Type

Private Type SArray
  Value(1 To 4) As Byte
End Type

Public Function FloatToBits(float As Variant, Optional FullBinary As Boolean = False) As String
Dim ByteArray() As Byte
Dim BitString As String
Dim i As Integer, n As Integer
Dim x As Double, y As Single
  If TypeName(float) = "Double" Then
    n = 8
    x = float
    ByteArray = DoubleToArray(x)
  ElseIf TypeName(float) = "Single" Then
    n = 4
    y = float
    ByteArray = SingleToArray(y)
  Else
    FloatToBits = "Error!"
    Exit Function
  End If

  For i = n To 1 Step -1
    BitString = BitString & ByteToString(ByteArray(i), FullBinary)
  Next i
  FloatToBits = BitString
End Function

Private Function DoubleToArray(DPFloat As Double) As Variant
Dim A As TDouble
Dim B As DArray
  A.Value = DPFloat
  LSet B = A
  DoubleToArray = B.Value
End Function

Private Function SingleToArray(SPFloat As Single) As Variant
Dim A As TSingle
Dim B As SArray
  A.Value = SPFloat
  LSet B = A
  SingleToArray = B.Value
End Function

Private Function ByteToString(B As Byte, Optional FullBinary As Boolean = False)
Dim BitString As String
  BitString = Hex(B)
  If Len(BitString) < 2 Then BitString = "0" & BitString
  If FullBinary Then
    BitString = HexToBin(Mid(BitString, 1, 1)) & HexToBin(Mid(BitString, 2, 1))
  End If
  ByteToString = BitString
End Function

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

Pour le test :

Sub test()
Dim x As Single
Dim y As Double
    x = 133.7194
    y = 133.7194

    Debug.Print FloatToBits(x)        '4305B82B
    Debug.Print FloatToBits(x, True)  '01000011000001011011100000101011
    Debug.Print FloatToBits(y)        '4060B705532617C2
    Debug.Print FloatToBits(y, True)  '0100000001100000101101110000010101010011001001100001011111000010

End Sub

Bonjour h2so4,

h2so4 a écrit :

'...
    MsgBox Hex(data8.b) & Hex(data8.a)

Avec LSet : Super méthode !

Mais attention au résultat :

    MsgBox Hex(data8.b) & Right("00000000" & Hex(data8.a), 8)

Mais attention au résultat :

 MsgBox Hex(data8.b) & Right("00000000" & Hex(data8.a), 8)

bien vu!

Merci !

Ca fonctionne parfaitement, c'est même du "prêt à l'emploi"!

Vous m'avez fait gagner un temps fou, encore merci.

Bon après-midi

Romain

Attention, si tu utilises des très très petits nombres, il faut aussi formater le premier Hex :

MsgBox Right("00000000" & Hex(data8.b),8) & Right("00000000" & Hex(data8.a), 8)