XL 2019 Traduire un array de bytes en string

xUpsilon · 23 Novembre 2023

Bonjour,

Je travaille en ce moment sur l'exploitation de données sortant d'un mesurage 3D.
Mon problème est le suivant : les données sortant du mesurage sont envoyées dans une base de données SQL en étant déjà formatées, et notamment un champ qui correspond à la description des points mesurés. Dans SQL Server management, ce champ est décrit comme un type "image".
En essayant de faire un Query sur ce serveur, Power Query me renvoie l'indicatif "Binary" à la place de la valeur du champ, en me disant qu'il ne reconnait pas le type de la donnée.
J'ai donc essayé de contourner le problème en me disant qu'exécuter cette Query en VBA me permettrait peut-être de contourner le problème en effectuant mon traitement dans un array R correspondant au Rst.GetRows de la Query. Sauf qu'à l'heure actuelle, si je regarde dans mes variables locales pendant l'exécution, j'ai effectivement dans cet écran des arrays R2 de bytes qui remontent, mais je n'arrive pas à aller boucler sur ces R2 pour réussir à ressortir ces bytes sont forme de string.

Concrètement, ça ressemble à ça dans mes variables locales :

En fait, cet array de bytes représente déjà un écart par rapport à ce que je peux lire dans SQL Server Management car je suis en Hexa en SQL et en décimal en VBA, par exemple ici le même élément que ci-dessus (5E = 94, etc ...) :

Est-ce que quelqu'un a une idée pour traduire un array de bytes en string ? Que ce soit une solution en SQL ou en VBA, je suis preneur.

Merci et bonne journée,

dysorthographie · 24 Novembre 2023

il faut que tu revois la structure de tes type personnalisés ça plante dès la déclaration Dim Logs(1000) As Log

Édite.
Merci pour le -1 sans explications mais je confirme si on arrêt l'exécution de la macro après la déclaration Dim Logs etc ça plante

ici LittleInd(10000) As String tuas un dépassement de capacité c'est ça qui provoque le plantage

Édite2.

VB:

Type Scheibe
    Points(35, 1) As Integer
End Type

Type Log
    LittleInd As New Scripting.Dictionary   'Référence Microsoft Scripting Runtime
    ScheibCount As String
    Scheiben(80) As Scheibe
    Size As Double
    D1Min As String
    D1Max As String
    D1Angle As String
    DMMin As String
    DMMax As String
    DMAngle As String
    D2Min As String
    D2Max As String...

dysorthographie · 24 Novembre 2023

TooFatBoy à dit:
Bonjour,

"FF" ce sont deux nibbles, ou un (et un seul) octet.

Bonjour,
Oui tu as raison me aculpa.

VB:

Sub test()
Dim bytArr(2) As Byte, txt As String
bytArr(0) = 94
bytArr(1) = 2
bytArr(2) = 255

txt = ByteToString(bytArr)
d = StringToByte(txt)
T = StringToSplite(txt)
b = ByteToTableau(bytArr)
End Sub


Function Base64Encoding(Buffer() As Byte) As String
With CreateObject("MSXML2.DOMDocument")    '.DOMDocument
   With .createElement("b64")  'MSXML2.IXMLDOMElement
        .DataType = "bin.base64"
        .nodeTypedValue = Buffer
        Base64Encoding = .Text
    End With
End With
End Function
Function Base64Decoding(Texte As String) As Byte()
With CreateObject("MSXML2.DOMDocument")    '.DOMDocument
   With .createElement("b64")  'MSXML2.IXMLDOMElement
        .DataType = "bin.base64"
        .Text = Texte
        Base64Decoding = .nodeTypedValue
    End With
End With
End Function
Function ByteToString(Buffer() As Byte) As String
For Each b In Buffer
    ByteToString = ByteToString & IIf(Len(Hex$(b)) = 1, "0" & Hex$(b), Hex$(b))
Next
End Function
Function ByteToTableau(Buffer() As Byte) As String()
Dim b() As String, i As Integer, C As Integer
ReDim b(UBound(Buffer))
For i = 0 To UBound(Buffer)
    b(i) = IIf(Len(Hex$(Buffer(i))) = 1, "0" & Hex$(Buffer(i)), Hex$(Buffer(i)))
Next
ByteToTableau = b
End Function

Function StringToByte(T As String) As Byte()
Dim b() As Byte, i As Integer, C As Integer
ReDim b((Len(T) / 2) - 1)
For i = 1 To Len(T) Step 2
    b(C) = "&h" & Mid(T, i, 2)
    C = C + 1
Next
StringToByte = b
End Function
Function StringToSplite(T As String) As String()
Dim b() As String, i As Integer, C As Integer
ReDim b((Len(T) / 2) - 1)
For i = 1 To Len(T) Step 2
    b(C) = Mid(T, i, 2)
    C = C + 1
Next
StringToSplite = b
End Function

Function LireFichierToByte(Fichier) As Byte()
 Dim Buffer() As Byte, intFileNumber, Fso As Object, objXML As Object, objNode As Object
    intFileNumber = FreeFile
    Set Fso = CreateObject("Scripting.FileSystemObject")
    ReDim Buffer(Fso.GetFile(Fichier).Size)
    Set Fso = Nothing
    Open Fichier For Binary As #intFileNumber
    While Not EOF(intFileNumber)
        Get #intFileNumber, , Buffer
    Wend
    LireFichierToByte = Buffer
End Function
Sub EcrireFichierToByte(Buffer() As Byte, Fichier)
 Dim intFileNumber, Fso As Object, objXML As Object, objNode As Object
intFileNumber = FreeFile
Open Fichier For Binary As #intFileNumber
Put #intFileNumber, , Buffer
End Sub

xUpsilon · 24 Novembre 2023

Re,

Déjà, merci pour ton bout de code @dysorthographie , qui répondra peut-être à ma problématique suivante (je m'en vais tester de suite) :
- J'arrive à remplir un array de strings avec mes couples de bytes inversés :

- Je cherche ensuite à retraiter ces couples de bytes pour aller les inscrire dans un type personnalisé qui comporte les quelques points les plus importants de mon exploitation de données :

Code:

Type Scheibe
    Points(35, 1) As Integer
End Type

Type Log
    LittleInd(10000) As String
    ScheibCount As String
    Scheiben(80) As Scheibe
    Size As Double
    D1Min As String
    D1Max As String
    D1Angle As String
    DMMin As String
    DMMax As String
    DMAngle As String
    D2Min As String
    D2Max As String
    D2Angle As String
    CalcD1Min As Integer
    CalcD1Max As Integer
    CalcD1Angle As Integer
    CalcDMMin As Integer
    CalcDMMax As Integer
    CalcDMAngle As Integer
    CalcD2Min As Integer
    CalcD2Max As Integer
    CalcD2Angle As Integer
End Type
    

Public Function ConvertByteToHex(b)
  If Len(VBA.Hex(b)) = 1 Then
     ConvertByteToHex = "0" & VBA.Hex(b)
  Else
      ConvertByteToHex = VBA.Hex(b)
End If
End Function

Sub CallFromDB()

Dim Logs(1000) As Log

Dim cn As ADODB.Connection
Set cn = New ADODB.Connection
Set rst = New ADODB.Recordset

'Définition de la Query ici
rst.Open Query, cn

arr = rst.GetRows

cn.Close

For nCol = LBound(arr, 2) To UBound(arr, 2)
    temp = arr(1, nCol)
    For n = LBound(temp) To UBound(temp) Step 2
        Logs(nCol).LittleInd(n / 2) = ConvertByteToHex(temp(n + 1)) & ConvertByteToHex(temp(n))
    Next n
    Logs(nCol).Size = CStr(Val("&H" & Logs(nCol).LittleInd(0)))
Next nCol

End Sub

Pour l'exemple, je ne mets ici que l'instruction avec le remplissage de la Size, ce qui suffit à générer mon problème.

- Lorsque j'exécute la macro, je viens donc traduire mes couples de bytes depuis l'array .LittleInd pour les mettre dans mes diverses variables (ici .Size). Pendant l'écriture/la traduction de ces valeurs, aucun souci, la macro se déroule parfaitement.
Pourtant, et c'est là qu'est mon nouveau problème : lorsque j'arrive à l'instruction End Sub, Excel crash en fermant toutes les fenêtres ouvertes dans la session. Problème similaire avec Exit Sub.

Est-ce que quelqu'un aurait une idée à tout hasard ?

Bonne journée,

xUpsilon · 24 Novembre 2023

Pour compléter ma demande, vous trouverez ci-joint un fichier sans données sensibles. J'ai pris un des télégrammes que j'ai copié/collé en A1 sur la feuille Sheet2.

J'utilise après ça la macro StringToByte de @dysorthographie pour simuler le résultat que je sors de mes Query en temps normal.
Une fois que j'ai ainsi rempli mon temp, j'essaye de l'utiliser pour remplir ma variable Logs(0). En arrivant à la fin de l'exécution, Excel crash.

Pour les curieux, vous trouverez sur Sheet1 une image du résultat qu'on cherche à obtenir : d'abord sortir les valeurs importantes (longueur, diamètres aux extrémités, etc...) d'un cône. Puis on va retraiter les données qui suivent dans le télégrammes pour en extraire les coordonnées de points mesurés. Une fois qu'on a les coordonnées, on peut ainsi reconstituer les cercles successifs mesurés par la machine, et avoir une idée de comment le cône défile et se tord à mesure qu'il avance dans le mesurage.

Bonne journée,

dysorthographie · 24 Novembre 2023

il faut que tu revois la structure de tes type personnalisés ça plante dès la déclaration Dim Logs(1000) As Log

Édite.
Merci pour le -1 sans explications mais je confirme si on arrêt l'exécution de la macro après la déclaration Dim Logs etc ça plante

ici LittleInd(10000) As String tuas un dépassement de capacité c'est ça qui provoque le plantage

Édite2.

VB:

Type Scheibe
    Points(35, 1) As Integer
End Type

Type Log
    LittleInd As New Scripting.Dictionary   'Référence Microsoft Scripting Runtime
    ScheibCount As String
    Scheiben(80) As Scheibe
    Size As Double
    D1Min As String
    D1Max As String
    D1Angle As String
    DMMin As String
    DMMax As String
    DMAngle As String
    D2Min As String
    D2Max As String
    D2Angle As String
    CalcD1Min As Integer
    CalcD1Max As Integer
    CalcD1Angle As Integer
    CalcDMMin As Integer
    CalcDMMax As Integer
    CalcDMAngle As Integer
    CalcD2Min As Integer
    CalcD2Max As Integer
    CalcD2Angle As Integer
End Type
 

Public Function ConvertByteToHex(b)
  If Len(VBA.Hex(b)) = 1 Then
     ConvertByteToHex = "0" & VBA.Hex(b)
  Else
      ConvertByteToHex = VBA.Hex(b)
End If
End Function

Sub TestWithRange()

Dim Logs(1000) As Log
nCol = 0

    temp = StringToByte(Range("A1").Value)
    For n = LBound(temp) To UBound(temp) Step 2
        Logs(nCol).LittleInd(n / 2) = ConvertByteToHex(temp(n + 1)) & ConvertByteToHex(temp(n))
    Next n
    Logs(nCol).Size = CStr(Val("&H" & Logs(nCol).LittleInd(0)))
    Logs(nCol).D1Min = CStr(Val("&H" & Logs(nCol).LittleInd(1)))
    Logs(nCol).D1Max = CStr(Val("&H" & Logs(nCol).LittleInd(2)))
    Logs(nCol).D1Angle = CStr(Val("&H" & Logs(nCol).LittleInd(3)))
    Logs(nCol).DMMin = CStr(Val("&H" & Logs(nCol).LittleInd(4)))
    Logs(nCol).DMMax = CStr(Val("&H" & Logs(nCol).LittleInd(5)))
    Logs(nCol).DMAngle = CStr(Val("&H" & Logs(nCol).LittleInd(6)))
    Logs(nCol).D2Min = CStr(Val("&H" & Logs(nCol).LittleInd(7)))
    Logs(nCol).D2Max = CStr(Val("&H" & Logs(nCol).LittleInd(8)))
    Logs(nCol).D2Angle = CStr(Val("&H" & Logs(nCol).LittleInd(9)))
    Logs(nCol).ScheibCount = CStr(Val("&H" & Logs(nCol).LittleInd(31)))
    For n = 0 To Logs(nCol).ScheibCount
        For nbis = 0 To 35
            If Left(CStr(Val("&H" & Logs(nCol).LittleInd(33 + nbis))), 2) = 3 Then
                Logs(nCol).Scheiben(n).Points(nbis, 0) = CStr(Val("&H" & Right(Logs(nCol).LittleInd(33 + nbis), 2)) - 255)
            Else
                Logs(nCol).Scheiben(n).Points(nbis, 0) = CStr(Val("&H" & Right(Logs(nCol).LittleInd(33 + nbis), 2)))
            End If
            If Left(CStr(Val("&H" & Logs(nCol).LittleInd(69 + nbis))), 2) = 0 Then
                Logs(nCol).Scheiben(n).Points(nbis, 0) = CStr(Val("&H" & Right(Logs(nCol).LittleInd(69 + nbis), 2)) - 255)
            Else
                Logs(nCol).Scheiben(n).Points(nbis, 0) = CStr(Val("&H" & Right(Logs(nCol).LittleInd(69 + nbis), 2)))
            End If
        Next nbis
    Next n
e = Logs(nCol).LittleInd.Items

End Sub

tu peux également écrire LittleInd() As String
et dans le code

VB:

For n = LBound(temp) To UBound(temp) Step 2
        ReDim Preserve Logs(nCol).LittleInd(n / 2)
        Logs(nCol).LittleInd(n / 2) = ConvertByteToHex(temp(n + 1)) & ConvertByteToHex(temp(n))
    Next n

pour limiter la taille en espérant ne jamais dépasser

xUpsilon · 30 Novembre 2023

Bonjour @dysorthographie ,

Je n'avais pas vu ton edit, m'y voilà maintenant. J'ai upvote ton post pour remettre le compteur à 0, quelqu'un est probablement passé par là et aurait missclick...
Pour ce qui est du dépassement de capacité, il y a quelque chose que je ne comprends pas. Si je ne touche pas à mon LittleIndian, mais que je remplis toutes mes autres variables de mon type avec des string, je n'ai pas de souci.

Si j'ai ceci je ne plante pas (Size as String) :

Code:

Type Scheibe
    Points(35, 1) As Integer
End Type

Type Log
    LittleInd(10000) As String
    ScheibCount As String
    Scheiben(80) As Scheibe
    Size As String
    D1Min As String
    D1Max As String
    D1Angle As String
    DMMin As String
    DMMax As String
    DMAngle As String
    D2Min As String
    D2Max As String
    D2Angle As String
End Type

Sub TestWithRange()

Dim Logs(1000) As Log
nCol = 0

    temp = StringToByte(Range("A1").Value)
    For n = LBound(temp) To UBound(temp) Step 2
        Logs(nCol).LittleInd(n / 2) = ConvertByteToHex(temp(n + 1)) & ConvertByteToHex(temp(n))
    Next n
    Logs(nCol).Size = CStr(Val("&H" & Logs(nCol).LittleInd(0)))
    Logs(nCol).D1Min = CStr(Val("&H" & Logs(nCol).LittleInd(1)))
    Logs(nCol).D1Max = CStr(Val("&H" & Logs(nCol).LittleInd(2)))
    Logs(nCol).D1Angle = CStr(Val("&H" & Logs(nCol).LittleInd(3)))
    Logs(nCol).DMMin = CStr(Val("&H" & Logs(nCol).LittleInd(4)))
    Logs(nCol).DMMax = CStr(Val("&H" & Logs(nCol).LittleInd(5)))
    Logs(nCol).DMAngle = CStr(Val("&H" & Logs(nCol).LittleInd(6)))
    Logs(nCol).D2Min = CStr(Val("&H" & Logs(nCol).LittleInd(7)))
    Logs(nCol).D2Max = CStr(Val("&H" & Logs(nCol).LittleInd(8)))
    Logs(nCol).D2Angle = CStr(Val("&H" & Logs(nCol).LittleInd(9)))
    temp = WorksheetFunction.RoundUp(CInt(Logs(nCol).Size) / 10, 0)
    Logs(nCol).ScheibCount = temp


End Sub

Par contre si j'ai ceci je plante (Size as Double, même plantage avec Size as Integer) :

Code:

Type Scheibe
    Points(35, 1) As Integer
End Type

Type Log
    LittleInd(10000) As String
    ScheibCount As String
    Scheiben(80) As Scheibe
    Size As Double
    D1Min As String
    D1Max As String
    D1Angle As String
    DMMin As String
    DMMax As String
    DMAngle As String
    D2Min As String
    D2Max As String
    D2Angle As String
End Type

Sub TestWithRange()

Dim Logs(1000) As Log
nCol = 0

    temp = StringToByte(Range("A1").Value)
    For n = LBound(temp) To UBound(temp) Step 2
        Logs(nCol).LittleInd(n / 2) = ConvertByteToHex(temp(n + 1)) & ConvertByteToHex(temp(n))
    Next n
    Logs(nCol).Size = CDbl(Val("&H" & Logs(nCol).LittleInd(0)))
    Logs(nCol).D1Min = CStr(Val("&H" & Logs(nCol).LittleInd(1)))
    Logs(nCol).D1Max = CStr(Val("&H" & Logs(nCol).LittleInd(2)))
    Logs(nCol).D1Angle = CStr(Val("&H" & Logs(nCol).LittleInd(3)))
    Logs(nCol).DMMin = CStr(Val("&H" & Logs(nCol).LittleInd(4)))
    Logs(nCol).DMMax = CStr(Val("&H" & Logs(nCol).LittleInd(5)))
    Logs(nCol).DMAngle = CStr(Val("&H" & Logs(nCol).LittleInd(6)))
    Logs(nCol).D2Min = CStr(Val("&H" & Logs(nCol).LittleInd(7)))
    Logs(nCol).D2Max = CStr(Val("&H" & Logs(nCol).LittleInd(8)))
    Logs(nCol).D2Angle = CStr(Val("&H" & Logs(nCol).LittleInd(9)))
    temp = WorksheetFunction.RoundUp(CInt(Logs(nCol).Size) / 10, 0)
    Logs(nCol).ScheibCount = temp


End Sub

Si c'est mon LittleIndian qui dépasse, je devrais systématiquement planter, qu'importe le type de mes autres variables, non ? Ou est-ce que les strings sont plus léger que les integer, et que c'est l'integer qui me pousse juste au dessus de la limite de la capacité ?

Bonne journée,

Update :
Il est vrai que si j'essaye de traiter mon ByteToString qui est stocké en A1, je n'ai pas de problèmes, même avec des integer :

VB:

Sub TestWithRange()

Dim Logs(1000) As Log
nCol = 0

    temp = StringToByte(Range("A1").Value)
    Logs(nCol).Size = CInt(Val("&H" & Mid(temp, 3, 2) & Mid(temp, 1, 2)))
    Logs(nCol).D1Min = CInt(Val("&H" & Mid(temp, 7, 2) & Mid(temp, 5, 2)))

End Sub

Donc visiblement tu as raison, ça vient de LittleInd, mais pour autant je ne comprends pas en quoi la capacité ne poserait pas problème lors d'un traitement exclusivement composé de strings.

dysorthographie · 1 Décembre 2023

bonjour,
en fait j'ai pas vraiment autopsier j'ai bidouillé par-ci par-là.

j'ai même tenté de réduire en limitant la taille des LittleInd(10000) As String * 4 vue que tu n'as besoins que de 4 caractères.

il te faut tenter d'optimiser chaque termes de ta structure mais je te confirme que je n'es pu que constater ou était le problème sans pour autant en comprendre ses méandre!

xUpsilon · 1 Décembre 2023

Re,

J'ai fini par lâcher l'affaire sur mes types perso et passer directement par un string grâce à ta fonction BytesToString plus haut.
Plus aucun plantage une fois qu'on traite avec des mid dans un grand string.

Merci pour ton aide en tout cas,
Bonne journée,

dysorthographie · 1 Décembre 2023

A ton service
A bientôt pour de nouvelles aventures

XL 2019 Traduire un array de bytes en string

xUpsilon

XLDnaute Accro

dysorthographie

dysorthographie

XLDnaute Accro

xUpsilon

XLDnaute Accro

xUpsilon

XLDnaute Accro

Pièces jointes

dysorthographie

XLDnaute Accro

xUpsilon

XLDnaute Accro

dysorthographie

XLDnaute Accro

xUpsilon

XLDnaute Accro

dysorthographie

XLDnaute Accro

Discussions similaires