Hexa - Ascii

**lowno** · 03/12/2013, 09h34

Bonjour.

J'avais précédement poster sur ce sujet et vous m'aviez grandement aidé.

Mais là je bloque sur la conception de la macro

Dans une cellule je colle un message du type :

08/01/2013 10:42:42 -
006100ee007600200070006100730020006e006f0972006d0061006c002e0020004e00670020
08/01/2013 10:42:42 -
100690073002000730075007200200070006c006100630095002c00200063006510200071007500690020006e00650020006d00650020007000610072

Je converti ensuite cette cellule de HEXA en ASCII via ce code :

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
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
Sub Button1_Click()
 
        Dim hexstring As String
        hexstring = ActiveCell.Value
        Dim charactersinstring
        charactersinstring = Len(hexstring) / 2
 
        Dim stringlength As Integer
        stringlength = Len(hexstring)
 
        Dim characters As String
 
        Dim assembledcharacters As String
 
        ReplacChrSpece (Chr(10) & Chr(13) & Chr(9) & "/" & "-" & ":")
 
 
        For i = 1 To stringlength
            characters = Mid(hexstring, i, 1)
            characters = characters & Mid(hexstring, i + 1, 1)
            i = i + 1
            If characters <> "00" Then
                assembledcharacters = assembledcharacters & Chr(Hex2Dec(characters)) 'fonction
            End If
        Next
 
        ActiveCell.Value = assembledcharacters
 
End Sub
 
Function ReplacChrSpece(t As String) As String
ReplacChrSpece = t
ReplacChrSpece = Replace(ReplacChrSpece, Chr(10), "") 'Retour charriau
ReplacChrSpece = Replace(ReplacChrSpece, Chr(13), "") 'Fin de ligne
ReplacChrSpece = Replace(ReplacChrSpece, Chr(9), "")  'Tabulation
ReplacChrSpece = Replace(ReplacChrSpece, "/", "")
ReplacChrSpece = Replace(ReplacChrSpece, "-", "")
ReplacChrSpece = Replace(ReplacChrSpece, ":", "")
End Function
 
 
Function Hex2Dec(ByVal n1 As String) As Long
        Dim nl1 As Long
        Dim nGVal As Long
        Dim nSteper As Long
        Dim nCount As Long
        Dim x As Long
        Dim nVal As Long
        Dim Stepit As Long
        Dim hVal As String
 
        nl1 = Len(n1)
        nGVal = 0
        nSteper = 16
        nCount = 1
        For x = nl1 To 1 Step -1
            hVal = UCase(Mid$(n1, x, 1))
            Select Case hVal
                Case "A"
                    nVal = 10
                Case "B"
                    nVal = 11
                Case "C"
                    nVal = 12
                Case "D"
                    nVal = 13
                Case "E"
                    nVal = 14
                Case "F"
                    nVal = 15
                Case Else
                    nVal = Val(hVal)
            End Select
            Stepit = (nSteper ^ (nCount - 1))
            nGVal = nGVal + nVal * Stepit
            nCount = nCount + 1
        Next x
        Hex2Dec = nGVal
    End Function

Mais j'ai 2 questions :

Comment faire ceci dans l'ordre :

1) En tout premier appelez cette partie de la Fonction "ReplacChrSpece" pour la cellule B12 :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
ReplacChrSpece = Replace(ReplacChrSpece, "/", "")
ReplacChrSpece = Replace(ReplacChrSpece, "-", "")
ReplacChrSpece = Replace(ReplacChrSpece, ":", "")

Puis, dans cette cellule B12 supprimer toutes les lignes de caractères inférieurs à 15 caractères

ex :
007889986978
05980004789900666e8a77ea0e000
00097899

Il faudra donc supprimer "007889986978" et "00097899"

2) appelez cette partie de la fonction :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
ReplacChrSpece = Replace(ReplacChrSpece, Chr(10), "") 'Retour charriau
ReplacChrSpece = Replace(ReplacChrSpece, Chr(13), "") 'Fin de ligne
ReplacChrSpece = Replace(ReplacChrSpece, Chr(9), "")  'Tabulation

Puis enfin, convertir

Un grand grand Merci car vous êtes toujours très pertinent.

A bientôt

**illight** · 03/12/2013, 09h58

Salut !

Je vais juste répondre à une question que tu poses :

1) En tout premier appelez cette partie de la Fonction "ReplacChrSpece" pour la cellule B12 :

ReplacChrSpece = Replace(ReplacChrSpece, "/", "")
ReplacChrSpece = Replace(ReplacChrSpece, "-", "")
ReplacChrSpece = Replace(ReplacChrSpece, ":", "")
...
2) appelez cette partie de la fonction :

ReplacChrSpece = Replace(ReplacChrSpece, Chr(10), "") 'Retour charriau
ReplacChrSpece = Replace(ReplacChrSpece, Chr(13), "") 'Fin de ligne
ReplacChrSpece = Replace(ReplacChrSpece, Chr(9), "") 'Tabulation

Tu as 2 solutions :
- soit tu scindes ta fonction en 2 => l'une avec ta première partie,e t l'autre avec la deuxième (solution de facilité

), genre :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
Function ReplacChrSpece1(t As String) As String
ReplacChrSpece = t
ReplacChrSpece = Replace(ReplacChrSpece, Chr(10), "") 'Retour charriau
ReplacChrSpece = Replace(ReplacChrSpece, Chr(13), "") 'Fin de ligne
ReplacChrSpece = Replace(ReplacChrSpece, Chr(9), "")  'Tabulation
End Function
 
Function ReplacChrSpece2(t As String) As String
ReplacChrSpece = Replace(ReplacChrSpece, "/", "")
ReplacChrSpece = Replace(ReplacChrSpece, "-", "")
ReplacChrSpece = Replace(ReplacChrSpece, ":", "")
End Function

Soit tu met un argument supplémentaire dans ta fonction :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
Function ReplacChrSpece(t As String,Ascii as boolean) As String
ReplacChrSpece = t
if ascii = True then
ReplacChrSpece = Replace(ReplacChrSpece, Chr(10), "") 'Retour charriau
ReplacChrSpece = Replace(ReplacChrSpece, Chr(13), "") 'Fin de ligne
ReplacChrSpece = Replace(ReplacChrSpece, Chr(9), "")  'Tabulation
else
ReplacChrSpece = Replace(ReplacChrSpece, "/", "")
ReplacChrSpece = Replace(ReplacChrSpece, "-", "")
ReplacChrSpece = Replace(ReplacChrSpece, ":", "")
End If
End Function

Du coup, pour cette question par exemple :

1) En tout premier appelez cette partie de la Fonction "ReplacChrSpece" pour la cellule B12 :

ReplacChrSpece = Replace(ReplacChrSpece, "/", "")
ReplacChrSpece = Replace(ReplacChrSpece, "-", "")
ReplacChrSpece = Replace(ReplacChrSpece, ":", "")

Tu appelle ta fonction comme ça :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

ReplacChrSpece ("/" & "-" & ":";False)

un truc dans le genre

(non testé

)

**EngueEngue** · 03/12/2013, 10h16

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
Sub toto()
hexValue = "4"
ascii = Asc(CStr(Application.WorksheetFunction.Hex2Dec(hexValue))) '52
dec = CStr(Application.WorksheetFunction.Hex2Dec(hexValue)) '4
End Sub

Pour la petite histoire, nous avons déjà des jolies méthodes pour les conversions

**lowno** · 03/12/2013, 10h49

Trés sympa de vous pencher sur mon cas ! : )

illight, Je ne comprend pas pourquoi lorsque j'appel la fonction elle ne fonctionne pas ! ( je sélectionne la cellule B12 puis j'appelle la fonction que j'ai scinder en 2 )

EngueEngue, ta méthode est remarquable ! Mais...Je doit tenir compte du fais que je doit d'abord mettre en "forme" le message ( supprimer les retours chariot, les espaces, les ":", les "/", les lignes de moins de 15 caractères etc, pas facilce

)

**illight** · 03/12/2013, 11h07

Qu'entend-tu par "ça fonctionne pas" ?

**lowno** · 03/12/2013, 12h03

Autant pour moi illight. L'appel de la fonction fonctionne ( sans jeu de mot )

Il ne reste plus qu'a trouver pour :

>Dans cette cellule B12 supprimer toutes les lignes de caractères inférieurs à 15 caractères

ex :
007889986978 'attention il y a un retour chariot
05980004789900666e8a77ea0e000
00097899

Il faudra donc supprimer "007889986978" et "00097899"

En tout cas je suis épaté par vos talent ... je suis encore loin du compte : )!

Hexa - Ascii

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager