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
161
162
163
164
165
|
Public Function CodeConvert(Text, char) 'Converts text from ala to 1256 codepage'
Dim jj, kk As Integer
On Error GoTo coderrmsg
Dim Text2 As String
Dim i, AscChr As Integer
Dim TempCheck As String
Text2 = Empty
If IsNull(Text) Then Exit Function
For i = 1 To Len(Text)
AscChr = Asc(Mid(Text, i, 1))
Select Case AscChr
Case 27
If (Mid([Text], i + 1, 2) = "(R") Then
TempCheck = Mid([Text], i, 8)
Select Case TempCheck
Case Chr(27) + "(Ra" + Chr(27) + "(BA"
Text2 = Text2 + ChrW(192)
Case Chr(27) + "(Rb" + Chr(27) + "(BA"
Text2 = Text2 + ChrW(193)
Case Chr(27) + "(Rc" + Chr(27) + "(BA"
Text2 = Text2 + ChrW(194)
Case Chr(27) + "(Rd" + Chr(27) + "(BA"
Text2 = Text2 + ChrW(195)
Case Chr(27) + "(Rh" + Chr(27) + "(BA"
Text2 = Text2 + ChrW(196)
Case Chr(27) + "(Rj" + Chr(27) + "(BA"
Text2 = Text2 + ChrW(197)
Case Chr(27) + "(R%" + Chr(27) + "(B"
Text2 = Text2 + ChrW(198)
Case Chr(27) + "(Rp" + Chr(27) + "(BC"
Text2 = Text2 + ChrW(199)
Case Chr(27) + "(Ra" + Chr(27) + "(BE"
Text2 = Text2 + ChrW(200)
Case Chr(27) + "(Rb" + Chr(27) + "(BE"
Text2 = Text2 + ChrW(201)
Case Chr(27) + "(Rc" + Chr(27) + "(BE"
Text2 = Text2 + ChrW(202)
Case Chr(27) + "(Rh" + Chr(27) + "(BE"
Text2 = Text2 + ChrW(203)
Case Chr(27) + "(Ra" + Chr(27) + "(BI"
Text2 = Text2 + ChrW(204)
Case Chr(27) + "(Rb" + Chr(27) + "(BI"
Text2 = Text2 + ChrW(205)
Case Chr(27) + "(Rc" + Chr(27) + "(BI"
Text2 = Text2 + ChrW(206)
Case Chr(27) + "(Rh" + Chr(27) + "(BI"
Text2 = Text2 + ChrW(207)
Case Chr(27) + "(Rd" + Chr(27) + "(BN"
Text2 = Text2 + ChrW(209)
Case Chr(27) + "(Ra" + Chr(27) + "(BO"
Text2 = Text2 + ChrW(210)
Case Chr(27) + "(Rb" + Chr(27) + "(BO"
Text2 = Text2 + ChrW(211)
Case Chr(27) + "(Rc" + Chr(27) + "(BO"
Text2 = Text2 + ChrW(212)
Case Chr(27) + "(Rd" + Chr(27) + "(BO"
Text2 = Text2 + ChrW(213)
Case Chr(27) + "(Rh" + Chr(27) + "(BO"
Text2 = Text2 + ChrW(214)
Case Chr(27) + "(Ra" + Chr(27) + "(BU"
Text2 = Text2 + ChrW(217)
Case Chr(27) + "(Rb" + Chr(27) + "(BU"
Text2 = Text2 + ChrW(218)
Case Chr(27) + "(Rc" + Chr(27) + "(BU"
Text2 = Text2 + ChrW(219)
Case Chr(27) + "(Rh" + Chr(27) + "(BU"
Text2 = Text2 + ChrW(220)
Case Chr(27) + "(Rb" + Chr(27) + "(BY"
Text2 = Text2 + ChrW(221)
Case Chr(27) + "(Ra" + Chr(27) + "(Ba"
Text2 = Text2 + ChrW(224)
Case Chr(27) + "(Rb" + Chr(27) + "(Ba"
Text2 = Text2 + ChrW(225)
Case Chr(27) + "(Rc" + Chr(27) + "(Ba"
Text2 = Text2 + ChrW(226)
Case Chr(27) + "(Rd" + Chr(27) + "(Ba"
Text2 = Text2 + ChrW(227)
Case Chr(27) + "(Rh" + Chr(27) + "(Ba"
Text2 = Text2 + ChrW(228)
Case Chr(27) + "(Rj" + Chr(27) + "(Ba"
Text2 = Text2 + ChrW(229)
Case Chr(27) + "(R5" + Chr(27) + "(B"
Text2 = Text2 + ChrW(230)
Case Chr(27) + "(Rp" + Chr(27) + "(Bc"
Text2 = Text2 + ChrW(231)
Case Chr(27) + "(Ra" + Chr(27) + "(Be"
Text2 = Text2 + ChrW(232)
Case Chr(27) + "(Rb" + Chr(27) + "(Be"
Text2 = Text2 + ChrW(233)
Case Chr(27) + "(Rc" + Chr(27) + "(Be"
Text2 = Text2 + ChrW(234)
Case Chr(27) + "(Rh" + Chr(27) + "(Be"
Text2 = Text2 + ChrW(235)
Case Chr(27) + "(Ra" + Chr(27) + "(Bi"
Text2 = Text2 + ChrW(236)
Case Chr(27) + "(Rb" + Chr(27) + "(Bi"
Text2 = Text2 + ChrW(237)
Case Chr(27) + "(Rc" + Chr(27) + "(Bi"
Text2 = Text2 + ChrW(238)
Case Chr(27) + "(Rh" + Chr(27) + "(Bi"
Text2 = Text2 + ChrW(239)
Case Chr(27) + "(Ra" + Chr(27) + "(Bo"
Text2 = Text2 + ChrW(242)
Case Chr(27) + "(Rb" + Chr(27) + "(Bo"
Text2 = Text2 + ChrW(243)
Case Chr(27) + "(Rc" + Chr(27) + "(Bo"
Text2 = Text2 + ChrW(244)
Case Chr(27) + "(Rd" + Chr(27) + "(Bo"
Text2 = Text2 + ChrW(245)
Case Chr(27) + "(Rh" + Chr(27) + "(Bo"
Text2 = Text2 + ChrW(246)
Case Chr(27) + "(Ra" + Chr(27) + "(Bu"
Text2 = Text2 + ChrW(249)
Case Chr(27) + "(Rb" + Chr(27) + "(Bu"
Text2 = Text2 + ChrW(250)
Case Chr(27) + "(Rc" + Chr(27) + "(Bu"
Text2 = Text2 + ChrW(251)
Case Chr(27) + "(Rh" + Chr(27) + "(Bu"
Text2 = Text2 + ChrW(252)
Case Chr(27) + "(Rb" + Chr(27) + "(By"
Text2 = Text2 + ChrW(253)
Case Chr(27) + "(Rh" + Chr(27) + "(By"
Text2 = Text2 + ChrW(255)
Case Else
End Select
i = i + 7
End If
' Debug.Print TempCheck
Case 136, 137
Case 31
If i > 1 Then Text2 = Text2 & char
i = i + 1
Case 162 'the quotations " character
Text2 = Text2 & Chr(34)
Case 167 'the Appostrophe Character
Text2 = Text2 & Chr(145)
Case 173 'the Hyphen
Text2 = Text2 & Chr(45)
Case 172
Text2 = Text2 & Chr(161)
Case 187
Text2 = Text2 & Chr(186)
Case 215 To 218
Text2 = Text2 & Chr(AscChr + 1)
Case 224 To 227
Text2 = Text2 & Chr(AscChr - 4)
Case 228
Text2 = Text2 & Chr(AscChr - 3)
Case 229 To 232
Text2 = Text2 & Chr(AscChr - 2)
Case 233 To 234
Text2 = Text2 & Chr(AscChr + 3)
Case Else
Text2 = Text2 & Chr(AscChr)
End Select
Next i
CodeConvert = Trim(Text2)
Exit Function
coderrmsg:
'MsgBox "Error in codeconvert, Please report to System Administrator. Text: " & Text & " Position: " & i
End Function |
Conversion VBA to SQL SERVER
Répondre avec citation
Partager