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 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160
| Function Lire(ByVal NomFichier As String)
Dim Chaine As String
Dim Ar() As String
Dim i As Long
Dim iRow As Long, iCol As Long
Dim NumFichier As Integer
Dim Separateur As String * 1
' Séparateur Tabulation
Separateur = Chr(9)
Cells.Clear
NumFichier = FreeFile
iRow = 1
Open NomFichier For Input As #NumFichier
Do While Not EOF(NumFichier)
iCol = 1
Line Input #NumFichier, Chaine
Chaine = Decode_UTF8(Chaine)
Ar = Split(Chaine, Separateur)
For i = LBound(Ar) To UBound(Ar)
Cells(iRow, iCol) = Ar(i)
iCol = iCol + 1
Next
iRow = iRow + 1
Loop
Close #NumFichier
End Function
Public Function isUTF8(astr)
Dim c0, c1, c2, c3
Dim n
isUTF8 = True
n = 1
Do While n <= Len(astr)
c0 = Asc(Mid(astr, n, 1))
If n <= Len(astr) - 1 Then
c1 = Asc(Mid(astr, n + 1, 1))
Else
c1 = 0
End If
If n <= Len(astr) - 2 Then
c2 = Asc(Mid(astr, n + 2, 1))
Else
c2 = 0
End If
If n <= Len(astr) - 3 Then
c3 = Asc(Mid(astr, n + 3, 1))
Else
c3 = 0
End If
If (c0 And 240) = 240 Then
If (c1 And 128) = 128 And (c2 And 128) = 128 And (c3 And 128) = 128 Then
n = n + 4
Else
isUTF8 = False
Exit Function
End If
ElseIf (c0 And 224) = 224 Then
If (c1 And 128) = 128 And (c2 And 128) = 128 Then
n = n + 3
Else
isUTF8 = False
Exit Function
End If
ElseIf (c0 And 192) = 192 Then
If (c1 And 128) = 128 Then
n = n + 2
Else
isUTF8 = False
Exit Function
End If
ElseIf (c0 And 128) = 0 Then
n = n + 1
Else
isUTF8 = False
Exit Function
End If
Loop
End Function
Public Function Encode_UTF8(astr)
Dim c
Dim n
Dim utftext
utftext = ""
n = 1
Do While n <= Len(astr)
c = AscW(Mid(astr, n, 1))
If c < 128 Then
utftext = utftext + Chr(c)
ElseIf ((c >= 128) And (c < 2048)) Then
utftext = utftext + Chr(((c \ 64) Or 192))
utftext = utftext + Chr(((c And 63) Or 128))
ElseIf ((c >= 2048) And (c < 65536)) Then
utftext = utftext + Chr(((c \ 4096) Or 224))
utftext = utftext + Chr((((c \ 64) And 63) Or 128))
utftext = utftext + Chr(((c And 63) Or 128))
Else ' c >= 65536
utftext = utftext + Chr(((c \ 262144) Or 240))
utftext = utftext + Chr(((((c \ 4096) And 63)) Or 128))
utftext = utftext + Chr((((c \ 64) And 63) Or 128))
utftext = utftext + Chr(((c And 63) Or 128))
End If
n = n + 1
Loop
Encode_UTF8 = utftext
End Function
Public Function Decode_UTF8(astr)
Dim c0, c1, c2, c3
Dim n
Dim unitext
If isUTF8(astr) = False Then
Decode_UTF8 = astr
Exit Function
End If
unitext = ""
n = 1
Do While n <= Len(astr)
c0 = Asc(Mid(astr, n, 1))
If n <= Len(astr) - 1 Then
c1 = Asc(Mid(astr, n + 1, 1))
Else
c1 = 0
End If
If n <= Len(astr) - 2 Then
c2 = Asc(Mid(astr, n + 2, 1))
Else
c2 = 0
End If
If n <= Len(astr) - 3 Then
c3 = Asc(Mid(astr, n + 3, 1))
Else
c3 = 0
End If
If (c0 And 240) = 240 And (c1 And 128) = 128 And (c2 And 128) = 128 And (c3 And 128) = 128 Then
unitext = unitext + ChrW((c0 - 240) * 65536 + (c1 - 128) * 4096) + (c2 - 128) * 64 + (c3 - 128)
n = n + 4
ElseIf (c0 And 224) = 224 And (c1 And 128) = 128 And (c2 And 128) = 128 Then
unitext = unitext + ChrW((c0 - 224) * 4096 + (c1 - 128) * 64 + (c2 - 128))
n = n + 3
ElseIf (c0 And 192) = 192 And (c1 And 128) = 128 Then
unitext = unitext + ChrW((c0 - 192) * 64 + (c1 - 128))
n = n + 2
ElseIf (c0 And 128) = 128 Then
unitext = unitext + ChrW(c0 And 127)
n = n + 1
Else ' c0 < 128
unitext = unitext + ChrW(c0)
n = n + 1
End If
Loop
Decode_UTF8 = unitext
End Function |
Partager